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

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

那么保存函数调用之间的全局变量的问题在于动态地将OLEObjects添加到工作表。当OLEObject从VBA代码添加到Worksheet时，项目需要重新编译，因为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

Answer 2

DropDownsCounter变量应该通过AddDropDowns（）的每次调用递增， 它仅在GetLastDropDownLeftPos（）中使用，但不在RemoveDropDowns（）中使用。

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

你有困惑NumberOfDropDowns与DropDownsCounter变量？

在你所有的VBA代码，你应该明确地声明变量，通过增加一个模块的头部：

Option Explicit 

这将给编译代码的错误进行调试。

Answer 3

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