如何保存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重置來重置項目。