Question

我在vba中创建了模块。我有两个函数“AddDropDowns”和“RemoveDropDowns”。在第一个函数中，我想将值存储在稍后可在第二个函数中访问的变量中。我在这两个函数所在的模块中声明了一个名为“DropDownsCounter”的变量，但变量并没有在函数调用之间保留它的值。我的问题是为什么以及如何实现这一目标？该模块的代码如下。

    Option Explicit    
        Private DropDownsCounter As Integer
        Public Const QueryAttributes = "Query1:Query2:Query3:Query4:Query5"

        Private Const DropDownsWidth = 70
        Private Const DropDownsHeight = 16.5    
        Function AddDropDowns()
            DropDownsCounter = DropDownsCounter + 1
            Dim QueryAttributesArray() As String
            Dim NumberOfDropDowns As Integer
            QueryAttributesArray() = Split(QueryAttributes, ":")
            Application.ScreenUpdating = False
            Dim x As Integer
            For x = 0 To UBound(QueryAttributesArray)
                Dim Name As String
                Name = "DropDown_" & (NumberOfDropDowns + x)
                Dim CmbBox As OLEObject
                Set CmbBox = Worksheets("Poizvedba").OLEObjects.Add("Forms.ComboBox.1")
                With CmbBox
                    .Left = GetLastDropDownLeftPos(DN)
                    .Top = Range(DNStartCell).Top + x * DropDownsHeight
                    .Width = DropDownsWidth
                    .Height = DropDownsHeight
                    .Name = Name
                End With
            Next x
            Application.ScreenUpdating = True
            End Function

    Function RemoveDropDowns()
        Dim QueryAttributesArray() As String
        Dim LastDropDown As Integer
        DropDownsCounter = DropDownsCounter - 9
        QueryAttributesArray() = Split(QueryAttributes, ":")
        Dim OleObj As OLEObject
        For Each OleObj In Worksheets("Poizvedba").OLEObjects
            Dim SplittedObjectName() As String
            SplittedObjectName() = Split(OleObj.Name, "_")
            If SplittedObjectName(0) = "DropDown" Then
                LastDropDown = SplittedObjectName(1)
            End If
        Next OleObj
        Dim StartIndexToRemove As Integer
        Dim EndIndexToRemove As Integer
        StartIndexToRemove = LastDropDown - UBound(QueryAttributesArray)
        EndIndexToRemove = LastDropDown
        Dim Sh As OLEObject
        For Each Sh In Worksheets("Poizvedba").OLEObjects
            Dim x As Integer
            For x = StartIndexToRemove To EndIndexToRemove
                If Sh.Name = "DropDown_" & x Then
                    Sh.Delete
                Exit For
                End If
            Next x
        Next Sh
    End Function

Private Function GetLastDropDownLeftPos(ByVal DropDownCategory As String) As Integer
    Dim pos As Integer
    pos = Range("A4").Width + Range("B4").Width + DropDownsWidth * DropDownsCounter
    GetLastDropDownLeftPos = pos
End Function

仍然失去变量值的新代码

工作表代码：

Public QueryDropDownsCollection As New Collection

Public Sub CommandButton1_Click()
    Dim NewQuery As QueryDropDown
    Set NewQuery = New QueryDropDown
    QueryDropDownsCollection.Add NewQuery
    Call NewQuery.Initialize(1, 20, 20, 70, 17, 9)
    NewQuery.AddDropDowns
End Sub

Public Sub CommandButton2_Click()
    QueryDropDownsCollection(QueryDropDownsCollection.Count - 1).RemoveDropDowns
End Sub

课程代码：

Private pID As Integer
Private pDropDownsWidth As Integer
Private pDropDownsHeight As Integer
Private pLeftPos As Integer
Private pTopPos As Integer
Private pNumberOfDropDowns As Integer
Private pDropDownNames() As String

Property Get ID() As Integer
    ID = pID
End Property

Private Const DropDownsWidth = 70
Private Const DropDownsHeight = 16.5

Public Sub Initialize(ByVal ID As Integer, ByVal LeftPos As Integer, ByVal TopPos As Integer, ByVal DropDownsWidth As Integer, ByVal DropDownsHeight As Integer, ByVal NumberOfDropDowns As Integer)
    pID = ID
    pLeftPos = LeftPos
    pTopPos = TopPos
    pDropDownsWidth = DropDownsWidth
    pDropDownsHeight = DropDownsHeight
    pNumberOfDropDowns = NumberOfDropDowns
    pSheet = Sheet
End Sub

Function AddDropDowns()
    For x = 0 To (pNumberOfDropDowns - 1)
        Dim Name As String
        Name = "DropDown_" & pID & "_" & x
        ReDim Preserve pDropDownNames(0 To x)
        pDropDownNames(x) = Name
        With ActiveSheet.OLEObjects.Add("Forms.ComboBox.1")
            .Left = LeftPos
            .Top = pTopPos + x * pDropDownsHeight
            .Width = pDropDownsWidth
            .Height = pDropDownsHeight
            .Name = Name
            With .Object
                .AddItem "Krneki1"
            End With
        End With
    Next x
End Function

Function RemoveDropDowns()
    Dim Sh As OLEObject
    For Each Sh In ActiveSheet.OLEObjects
        Dim x As Integer
        For x = 0 To pNumberOfDropDowns
            If Sh.Name = pDropDownNames(x) Then
                Sh.Delete
            Exit For
            End If
        Next x
    Next Sh
End Function

Answer 1

变量DropDownsCounter应该在每次调用AddDropDowns（）时递增，它仅用于GetLastDropDownLeftPos（），但不用于RemoveDropDowns（）。

在AddDropDowns（）中，变量NumberOfDropDowns是一个局部变量，在RemoveDropDowns（）中，变量NumberOfDropDowns是隐式全局变量。

您是否将NumberOfDropDowns与DropDownsCounter变量混淆了？

在所有VBA代码中，您应该通过添加模块的标题明确声明您的变量：

Option Explicit

这将导致代码的编译错误以进行调试。

Answer 2

我建议创建一个类模块来管理下拉菜单。然后，您可以在普通模块中使用Public，Module级别声明对其进行实例化。属性和内部变量将在调用之间保留它们的值，直到通过End语句或VBE重置项目重置项目。

Answer 3

在函数调用之间保留全局变量的问题在于动态地将OLEObject添加到工作表。当从VBA代码向工作表添加OLEObject时，项目需要重新编译，因为OLEObject本身成为项目的属性。它是重新编译的过程，它会丢失所有变量值。我也发现了一些对这个问题的引用：

http://www.pcreview.co.uk/forums/dynamically-adding-activex-controls-via-vba-kills-global-vba-heap-t3763287p2.html

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_23574623.html

如何在vba模块中的函数调用之间保留变量值？

3 个答案: