Software Consulting Services
Truly Global Variables In VBA
Excel supports "global" variables only at the workbook level. If you declare a variable using the Public declaration in a standard code module, that variable and its value is available to any procedure in any module of the project. Additionally, it is available to any VBProject that has a reference set the workbook containing the variable declaration. These variables can be considered "global" in the sense that they are accessible between projects, but they suffer from significant shortcomings, namely that the workbook that contains the variable must be open, a reference must be set to that workbook's project from other projects that need to access that variable, and you can't close the workbook containing the variable declarations as long as other open workbooks reference that workbook. Using a few Windows API calls, you can create numeric (Long type) variables that are truly global to the entire Excel application. These variables are not stored in or associated with any particular workbook. Once created, they can be accessed by any workbook, with no references required. Moreover, these variables will exist and maintain their values as long as Excel itself is running. You can open and close any workbooks, including the workbook that created the variable, without losing the variable and its value. This page provides example procedures for creating, retrieving and deleting these global variables. Note that these variables may contain only Long type numeric data. In Windows, a window maintains a Property List, which can contain string values and numeric data associated with each string value. You can add string values and associated numeric data to a window's Property List using the SetProp API function. The window's Property List is maintained as long as the window exists. The GetProp API function is used to retrieve the value of an existing element in the window's Property List. By storing string values and associated numeric data in the main Excel application window's Property List, you can create named values that will exist as long as Excel is open. The variable will be destroyed with Excel itself shuts down. Since these values are stored with the main Excel application's window, they will exist as long as Excel is open, regardless of what workbooks you open and close, including the workbook that created the variable. As a practical matter, you are not restricted to saving values in the Excel application window's Property List. You can also store values in the Property List of a UserForm. This allows you to store information or create form properties at run-time. No code in the UserForm need be changed in order to store properties in the form's Property List. You can also store properties associated with the Desktop window. When you do this, the properties will remain intact even if you shutdown Excel. They will remain attached to the Desktop window until Windows itself shuts down. You attach a property to the Desktop window in the same manner that you would use for any other window. The VBA code contains a function called GetDesktopHandle which will return the window handle of the Desktop. See also the Hidden Name Space for another method of using names and values that remain accessible until the application is closed. The procedures require a class module named CPropType. This class is included in the download files, or you can create your own. In VBA choose Class Module from the Insert menu and press F4 to display the Properties window. There, change the Name to CPropType, and paste in the following code: Option Explicit Public Name As String Public Value As Long This is the entire contents of the class. This class is used by the GetAllProperties function (see below). Below are several VBA functions to support a saving and
retrieving data window's property list. The code requires Excel 2000
or later. Public Function SetProperty(PropertyName As String, PropertyValue As Long, _ Optional HWnd As Long = 0) As Boolean This sets a property name with the name in
PropertyName and its associated numeric value in PropertyValue. If the property
name does not exist, it is created. If the property name does exist, its
associated value is updated to the new value in PropertyValue. If HWnd is
omitted or is less than or equal to 0, the main Excel application window's
Property List is used. Otherwise, the property list of the window referenced
by HWnd is used. Public Function GetProperty(PropertyName As String, ByRef PropertyValue As Long, _ Optional HWnd As Long = 0) As Boolean This gets the value associated with the property name
named in PropertyName. It populates the variable PropertyValue with the value, if it exists. This procedure returns True
or False indicating whether the value was successfully retrieved. If it
returns False, most likely the specified property does not exist, and the
PropertyValue variable is left unchanged. If HWnd is omitted or is less than
or equal to 0, the main Excel application window's Property List is used.
Otherwise, the property list of the window referenced by HWnd is used. Public Function GetAllProperties(ResultArray As Variant, _ Optional HWnd As Long = 0) As Long This function populates ResultArray with instances of the CPropType class. This class is included in the downloadable files. Each element of the array is an instance of the CPropType class, each of which contains the name and associated value of an item in the window's Property List. If HWnd is omitted or is less than or equal to 0, the main Excel application window's Property List is used. Otherwise, the property list of the window referenced by HWnd is used. To use the GetAllProperties function, use code like the following in the calling procedure: Sub TestGetAll() '''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This proc illustrates the GetAllProperties function. '''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim PropArray() As CPropType ' MUST be a dynamic array Dim Res As Long Dim N As Long Res = GetAllProperties(ResultArray:=PropArray, HWnd:=0) Select Case Res Case Is > 0 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' At least one property was found. Loop through the array, ' displaying each property and its value. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' For N = LBound(PropArray) To UBound(PropArray) Debug.Print CStr(N), PropArray(N).Name, CStr(PropArray(N).Value) Next N Case 0 ''''''''''''''''''''''''''' ' No properties were found. ''''''''''''''''''''''''''' Debug.Print "No properties were found for the specified window." Case Else '''''''''''''''''''' ' An error occurred. '''''''''''''''''''' Debug.Print "An error occurred." End Select End Sub Public Function PropertyExists(PropertyName As String, _ Optional HWnd As Long = 0) As Boolean This
returns True or False indicating whether the specified property exists. If
HWnd is omitted or is less than or equal to 0, the main Excel application
window's Property List is used. Otherwise, the property list of the window
referenced by HWnd is used. Public Function RemoveProperty(PropertyName As String, _ Optional HWnd As Long = 0) As Boolean This removes the property named in PropertyName from the
property list. If HWnd is omitted or is less than or equal to 0, the main
Excel application window's Property List is used. Otherwise, the property
list of the window referenced by HWnd is used. The function returns True if
the property is successfully removed. The function will return True if the
specified property does not exist, because the net effect is the same as if
the property existed and was deleted. GetHWndOfForm Public Function GetHWndOfForm(UF As Object) As Long This returns the HWnd of the specified UserForm in UF. Use this procedure to get the HWnd for a form if you are storing values in a UserForm's Property List. This function returns the value that you pass in the HWnd parameter to the other functions. All of these procedures, except GetHWndOfForm, have an optional parameter called HWnd. If this parameter is omitted or is less than or equal to 0, property strings and their associated values are stored in and retrieved from the Excel application's main window's property list. You can use the HWnd parameter to store data in another window's property list, such as a user form. The GetHWndOfForm procedure can be used to retrieve the HWnd of a specific UserForm. The code requires a class module named CPropType. The entire contents of the class module are: Option Explicit Public Name As String Public Value As Long To create the class module in your project, select Class Module from the Insert menu in VBA, press F4 to display the Properties window, change the name of the class module from Class1 to CPropType and paste in the lines above. The complete code for the modGetSetProps code module is shown below. You can download the code module and the required class module here or download a complete Excel workbook with demonstration procedures here. Option Explicit Option Compare Text ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' modGetSetProps ' By Chip Pearson, www.cpearson.com, chip@cpearson.com ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' This module contains functions for adding and retrieving property values (Long ' data types) of a window, typically the Excel application's main window. These ' values will remain accessible even when the workbook that created them is closed. ' They will be accessible from any code in any workbook as long as the window exists. ' Usually, you will want to use the Excel main application window (the default for all ' procedures) to store the properties. These properties will persist until Excel closes. ' ' Note that the property can contain only Long data values. ' ' This module contains the following Public procedures (not including Private ' support procedures): ' ' GetAllProperties - This populates an array of CPropType classes, ' one instance for each property retrieved. ' See the documentation in this procedure for ' details about calling it. ' GetDesktopHandle - This function returns the handle of the Windows desktop. ' GetProperty - This procedure gets the value of the specified ' property. ' RemoveProperty - This procedure removes the property from the window's ' property list. ' SetProperty - This creates an new property or updates an existing ' property. ' GetHWndOfForm - This returns the HWnd of the UserForm that is passed ' in to the procedure. This is to be used if you are ' storing values in the UserForm window's property list. ' GetNewCPropType - This returns a New CPropType class instance. This ' procedure is intended to be used when calling these ' procedures for other VBProjects that reference this ' Project. If you import this module and the CPropType ' class into your project, you can create a new CPropType ' instance with the New keyword -- you don't need to ' use the GetNewCPropType function. ' ' All of these procedures have an optional argument name HWnd. If this ' argument is omitted or is <= 0, the properties are stored in the main ' Excel application window's property list. If HWnd is included and is > 0, ' the property list for that window is used. If you want to store properties ' in a UserForm's property list, you can call HWnd = GetHWndOfForm(UF:=YourFormName) ' to retrieve the HWnd of the form, and pass this value in the HWnd parameter ' to the various function to set or retrieve the property value. ' ' The following are the Private procedures that are used to support the Public ' procedures in this module. You don't need to access these Private procedures (that ' is why they are declared as Private). They are used to support the Public procedures. ' ' IsArrayAllocated ' IsArrayDynamic ' IsArrayEmpty ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Declare Function IsWindow Lib "user32" ( _ ByVal HWnd As Long) As Long Private Declare Function GetProp Lib "user32" Alias "GetPropA" ( _ ByVal HWnd As Long, _ ByVal lpString As String) As Long Private Declare Function SetProp Lib "user32" Alias "SetPropA" ( _ ByVal HWnd As Long, _ ByVal lpString As String, _ ByVal hData As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" ( _ ByVal HWnd As Long, _ ByVal lpString As String) As Long Private Declare Function EnumProps Lib "user32.dll" Alias "EnumPropsA" ( _ ByVal HWnd As Long, _ ByVal lpEnumFunc As Long) As Long '''''''''''''''''''''''''''''''''''''''''''''''' ' Note: The Visual Studio 6 API Viewer program ' shows the lpString type as String, not Long. ' It is incorrect. lpString needs to be a Long. '''''''''''''''''''''''''''''''''''''''''''''''' Private Declare Function LStrLen Lib "kernel32" Alias "lstrlenA" ( _ ByVal lpString As Long) As Long '''''''''''''''''''''''''''''''''''''''''''''''' ' Note: The Visual Studio 6 API Viewer program ' shows the lpString2 type as String, not Long. ' It is incorrect. lpString2 needs to be a Long. '''''''''''''''''''''''''''''''''''''''''''''''' Private Declare Function LStrCpy Lib "kernel32.dll" Alias "lstrcpyA" ( _ ByVal lpString1 As String, _ ByVal lpString2 As Long) As Long '''''''''''''''''''''''''''''''''''''''' ' These two variables are used with the ' GetAllProperties procedure. See the ' documentation in GetAllProperties ' for details. '''''''''''''''''''''''''''''''''''''''' Private ArrayNdx As Long Private ListAllArray() As CPropType '''''''''''''''''''''''''''''''''''''''' ' These two variables are used with the ' PropertyExists procedure. See the ' documentation in PropertyExists ' procedure for details. '''''''''''''''''''''''''''''''''''''''' Private PropertyToFind As String Private PropertyFound As Boolean Public Function GetDesktopHandle() As Long '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' GetDesktopHandle ' This returns the windows handle of the desktop window. '''''''''''''''''''''''''''''''''''''''''''''''''''''''' GetDesktopHandle = GetDesktopWindow() End Function Public Function GetNewCPropType() As CPropType '''''''''''''''''''''''''''''''''''''''''''''''' ' GetNewCPropType ' This returns a new instance of CPropType to the ' calling procedure. This is to be used when you are ' calling these procedures from another VBAProject ' that references this project. If you import this ' module into the project, you can simply create ' a new class instance with the New keyword. E.g., ' Dim PT As CPropType ' Set PT = New CPropType ' The Instancing property of CPropType is ' PublicNotCreatable, so another project can ' declare a variable of that type, but not create ' an instance of the class. This function creates ' and returns a new instance of CPropType. E.g., ' ' Dim PT As projGetSetProps.CPropType ' Set PT = projGetSetProps.GetNewCPropType() ' '''''''''''''''''''''''''''''''''''''''''''''''' Set GetNewCPropType = New CPropType End Function Public Function SetProperty(PropertyName As String, PropertyValue As Long, _ Optional HWnd As Long = 0) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' SetProperty ' This function adds a property entry named PropertyName with the value ' PropertyValue to the window indentified by HWnd. If HWnd is omitted or ' <= 0, it is added to the main Excel application window's property list. ' The function returns True if the operation was successful, or False ' if an error occurred. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Res As Long Dim DestHWnd As Long ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' If HWnd was omitted or <= 0, use the Excel main application ' window HWnd. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If HWnd <= 0 Then DestHWnd = FindWindow("XLMAIN", Application.Caption) Else DestHWnd = HWnd End If If DestHWnd = 0 Then SetProperty = False Exit Function End If ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure PropertyName is not an empty string. ''''''''''''''''''''''''''''''''''''''''''''' If Trim(PropertyName) = vbNullString Then SetProperty = False Exit Function End If ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure DestHWnd is an existing window. ''''''''''''''''''''''''''''''''''''''''''''' If IsWindow(DestHWnd) = 0 Then SetProperty = False Exit Function End If Res = SetProp(HWnd:=DestHWnd, lpString:=PropertyName, hData:=PropertyValue) If Res = 0 Then ''''''''''''''''''''' ' An error occurred. ''''''''''''''''''''' SetProperty = False Else ''''''''''''''''''''' ' Success. ''''''''''''''''''''' SetProperty = True End If End Function Public Function GetAllProperties(ResultArray As Variant, _ Optional HWnd As Long = 0) As Long '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' GetAllProperties ' This procedure creates an array in ResultArray, each element of which ' is an instance of the CPropType class, containing the name and value ' of each property in the property list of the window specified by HWnd. ' If HWnd is omitted or <= 0, the main Excel application window's property ' list is used. ' ' ResultArray must be a dynamic, one-dimensional array. The existing ' contents of ResultArray will be destroyed. ' ' The function returns the number of elements added to ResultArray, ' or -1 if an error occurred. The calling procedure should declare ' a dynamic array of CPropType classes, each of which will store the ' name and value of one property: ' ' Dim PropArray() As CPropType ' ' It should then pass that array to this procedure: ' ' Dim Res As Long ' Res = GetAllProperties(ResultArray:=PropArray, HWnd:=0) ' ' This procedure will Erase and then repopulate ResultArray with instances ' of CPropType objects. Upon return from this procedure, the calling ' procedure should loop through the array: ' ' If Res > 0 Then ' ' One or more properties are stored in PropArray ' For N = LBound(PropArray) To UBound(PropArray) ' Debug.Print CStr(N), PropArray(N).Name, PropArray(N).Value ' Next N ' ElseIf Res = 0 Then ' ' No properties were found for the specified window. ' Debug.Print "No properties were found." ' Else ' ' An error occurred. ' Debug.Print "An error occurred with GetAllProperties." ' End If ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Res As Long Dim DestHWnd As Long Dim Counter As Long Dim Ndx As Long Dim PT As CPropType ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' If HWnd was omitted or <= 0, use the Excel main application ' window HWnd. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If HWnd <= 0 Then DestHWnd = FindWindow("XLMAIN", Application.Caption) Else DestHWnd = HWnd End If If DestHWnd = 0 Then GetAllProperties = -1 Exit Function End If '''''''''''''''''''''''''''''''''' ' Ensure ResultArray is an array. '''''''''''''''''''''''''''''''''' If IsArray(ResultArray) = False Then GetAllProperties = -1 Exit Function End If '''''''''''''''''''''''''''''''''' ' Ensure ResultArray is dynamic. '''''''''''''''''''''''''''''''''' If IsArrayDynamic(Arr:=ResultArray) = False Then GetAllProperties = -1 Exit Function End If ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure DestHWnd is an existing window. ''''''''''''''''''''''''''''''''''''''''''''' If IsWindow(DestHWnd) = 0 Then GetAllProperties = -1 Exit Function End If ''''''''''''''''''''''''''''''''''''''''''''' ' Erase the existing ListAllArray and set the ' ArrayNdx variable to 0. Erase the ResultArray ' so we can repopulate it with instances of ' CPropType. Erase the ListAllArray to start ' with a new set of class instances. '''''''''''''''''''''''''''''''''''''''''''''' Erase ListAllArray Erase ResultArray ArrayNdx = 0 ''''''''''''''''''''''''''''''''''''''''''''''' ' Call EnumProps to get all the properties of ' DestHWnd's property list. Windows will call ' ProcEnumPropForListAll for each property ' in the window's property list. ''''''''''''''''''''''''''''''''''''''''''''''' Res = EnumProps(HWnd:=DestHWnd, lpEnumFunc:=AddressOf ProcEnumPropForListAll) '''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Redim the ResultArray to the number of properties ' enumerated by EnumProps. Copy the array ListAllArray ' to ResultArray. ''''''''''''''''''''''''''''''''''''''''''''''''''''''' If IsArrayAllocated(Arr:=ListAllArray) = True Then ReDim ResultArray(1 To UBound(ListAllArray)) Set PT = New CPropType For Ndx = LBound(ListAllArray) To UBound(ListAllArray) Set PT = ListAllArray(Ndx) PT.Name = ListAllArray(Ndx).Name PT.Value = ListAllArray(Ndx).Value Set ResultArray(Ndx) = PT Next Ndx End If '''''''''''''''''''''''''''''''''''''''''''''''''' ' If the array is allocated, we retrieved at least ' one property. Return the number of properties ' retrieved. If the array is not allocated, there ' were no properties to retrieve, so return 0. '''''''''''''''''''''''''''''''''''''''''''''''''' If IsArrayAllocated(Arr:=ResultArray) = True Then GetAllProperties = UBound(ResultArray) Else GetAllProperties = 0 End If End Function Public Function GetProperty(PropertyName As String, ByRef PropertyValue As Long, _ Optional HWnd As Long = 0) As Boolean ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' GetProperty ' This function retrieves the value of PropertyName from ' the window specified by HWnd. If HWnd is omitted or <= 0, ' it looks in the main Excel application window's property ' list. It will place the value of the specified property ' in the variable passed as PropertyValue. You must pass ' a Long type of variable for PropertyValue. ' The function returns True if the operation was successful, ' or False if an error occurred. If an error occurs, the ' variable PropertyValue is left unchanged. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Res As Long Dim DestHWnd As Long ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' If HWnd was omitted or is <= 0, use the Excel main application ' window HWnd. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If HWnd <= 0 Then DestHWnd = FindWindow("XLMAIN", Application.Caption) Else DestHWnd = HWnd End If ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure DestHWnd is an existing window. ''''''''''''''''''''''''''''''''''''''''''''' If IsWindow(DestHWnd) = 0 Then GetProperty = False Exit Function End If ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure PropertyName is not an empty string. ''''''''''''''''''''''''''''''''''''''''''''' If Trim(PropertyName) = vbNullString Then GetProperty = False Exit Function End If Res = GetProp(DestHWnd, PropertyName) ''''''''''''''''''''''''''''''''''''' ' GetProp will return 0 if an error ' occurred, but 0 may also be a valid ' property value. Test Err.LastDllError ' to see if an error occurred. If it ' indicates an error, it is most likely ' that the property doesn't exist ' (Err.LastDllError = 2). ''''''''''''''''''''''''''''''''''''' If Err.LastDllError <> 0 Then GetProperty = False Else PropertyValue = Res GetProperty = True End If End Function Public Function PropertyExists(PropertyName As String, _ Optional HWnd As Long = 0) As Boolean ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' PropertyExists ' This function returns True or False indicating whether the ' property with the string value PropertyName exists for the ' window specified in HWnd. If HWnd is omitted or <= 0, the ' main Excel application window's property list is searched. ' The function returns True if the property exists or False ' if the property does not exist or an error occurred. ' It calls EnumProps to enumerate all the properties in ' the Propety List for HWnd, looking for a property whose ' name is the same as the value of PropertyName. ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Res As Long Dim DestHWnd As Long ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' If HWnd was omitted or <= 0, use the Excel main application ' window HWnd. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If HWnd <= 0 Then DestHWnd = FindWindow("XLMAIN", Application.Caption) Else DestHWnd = HWnd End If ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure DestHWnd is an existing window. ''''''''''''''''''''''''''''''''''''''''''''' If IsWindow(DestHWnd) = 0 Then PropertyExists = False Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''''''' ' Set PropetyFound to False and set PropertyToFind ' the the property name we're looking for. '''''''''''''''''''''''''''''''''''''''''''''''''' PropertyFound = False PropertyToFind = PropertyName ''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Call EnumProps, passing it the address of the ' ProcEnumPropForFind function. The ProcEnumPropForFind ' function will be called by Windows one time for each ' property in the window's property list. ' ProcEnumPropForFind will test the name of each property ' against PropertyToFind and if a match is found, it ' will set PropertyFound to True and terminate the ' enumeration. ''''''''''''''''''''''''''''''''''''''''''''''''''''''' Res = EnumProps(DestHWnd, AddressOf ProcEnumPropForFind) PropertyExists = PropertyFound End Function Public Function RemoveProperty(PropertyName As String, _ Optional HWnd As Long = 0) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' RemoveProperty ' This function removes the property named by PropertyName from the property ' list of the window specified by HWnd. If HWnd is omitted or <= 0, then ' main Excel application window's property list is used. ' The function returns True if the operation was successful, or False if ' an error occurred. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Res As Long Dim DestHWnd As Long ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' If HWnd was omitted or <= 0, use the Excel main application ' window HWnd. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If HWnd <= 0 Then DestHWnd = FindWindow("XLMAIN", Application.Caption) Else DestHWnd = HWnd End If ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure DestHWnd is an existing window. ''''''''''''''''''''''''''''''''''''''''''''' If IsWindow(DestHWnd) = 0 Then RemoveProperty = False Exit Function End If ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure PropertyName is not an empty string. ''''''''''''''''''''''''''''''''''''''''''''' If Trim(PropertyName) = vbNullString Then RemoveProperty = False Exit Function End If Res = RemoveProp(DestHWnd, PropertyName) '''''''''''''''''''''''''''''''' ' If PropertyName doesn't exist ' we'll get an error value in Res. ' We can safely ignore this error ' and return True. '''''''''''''''''''''''''''''''' RemoveProperty = True End Function Public Function GetHWndOfForm(UF As Object) As Long ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' GetHWndOfForm ' This returns the HWnd of the UserForm referenced in UF. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim HWnd As Long HWnd = FindWindow("ThunderDFrame", UF.Caption) GetHWndOfForm = HWnd End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Private Support Procedures ' These functions are documented and available for download at ' http://www.cpearson.com/excel/vbaarrays.htm. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Function IsArrayAllocated(Arr As Variant) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' IsArrayAllocated ' Returns TRUE if the array is allocated (either a static array or a dynamic array that has been ' sized with Redim) or FALSE if the array is not allocated (a dynamic that has not yet ' been sized with Redim, or a dynamic array that has been Erased). Static arrays are always ' allocated. ' ' The VBA IsArray function indicates whether a variable is an array, but it does not ' distinguish between allocated and unallocated arrays. It will return TRUE for both ' allocated and unallocated arrays. This function tests whether the array has actually ' been allocated. ' ' This function is just the reverse of IsArrayEmpty. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim N As Long On Error Resume Next ' if Arr is not an array, return FALSE and get out. If IsArray(Arr) = False Then IsArrayAllocated = False Exit Function End If ' Attempt to get the UBound of the array. If the array has not been allocated, ' an error will occur. Test Err.Number to see if an error occurred. N = UBound(Arr, 1) If (Err.Number = 0) Then '''''''''''''''''''''''''''''''''''''' ' Under some circumstances, if an array ' is not allocated, Err.Number will be ' 0. To acccomodate this case, we test ' whether LBound <= Ubound. If this ' is True, the array is allocated. Otherwise, ' the array is not allocated. ''''''''''''''''''''''''''''''''''''''' If LBound(Arr) <= UBound(Arr) Then ' no error. array has been allocated. IsArrayAllocated = True Else IsArrayAllocated = False End If Else ' error. unallocated array IsArrayAllocated = False End If End Function Private Function IsArrayDynamic(ByRef Arr As Variant) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' IsArrayDynamic ' This function returns TRUE or FALSE indicating whether Arr is a dynamic array. ' Note that if you attempt to ReDim a static array in the same procedure in which it is ' declared, you'll get a compiler error and your code won't run at all. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim LUBound As Long ' If we weren't passed an array, get out now with a FALSE result If IsArray(Arr) = False Then IsArrayDynamic = False Exit Function End If ' If the array is empty, it hasn't been allocated yet, so we know ' it must be a dynamic array. If IsArrayEmpty(Arr:=Arr) = True Then IsArrayDynamic = True Exit Function End If ' Save the UBound of Arr. ' This value will be used to restore the original UBound if Arr ' is a single-dimensional dynamic array. Unused if Arr is multi-dimensional, ' or if Arr is a static array. LUBound = UBound(Arr) On Error Resume Next Err.Clear ' Attempt to increase the UBound of Arr and test the value of Err.Number. ' If Arr is a static array, either single- or multi-dimensional, we'll get a ' C_ERR_ARRAY_IS_FIXED_OR_LOCKED error. In this case, return FALSE. ' ' If Arr is a single-dimensional dynamic array, we'll get C_ERR_NO_ERROR error. ' ' If Arr is a multi-dimensional dynamic array, we'll get a ' C_ERR_SUBSCRIPT_OUT_OF_RANGE error. ' ' For either C_NO_ERROR or C_ERR_SUBSCRIPT_OUT_OF_RANGE, return TRUE. ' For C_ERR_ARRAY_IS_FIXED_OR_LOCKED, return FALSE. ReDim Preserve Arr(LBound(Arr) To LUBound + 1) Select Case Err.Number Case 0 ' We successfully increased the UBound of Arr. ' Do a ReDim Preserve to restore the original UBound. ReDim Preserve Arr(LBound(Arr) To LUBound) IsArrayDynamic = True Case 9 ' Arr is a multi-dimensional dynamic array. ' Return True. IsArrayDynamic = True Case 10 ' Arr is a static single- or multi-dimensional array. ' Return False IsArrayDynamic = False Case Else ' We should never get here. ' Some unexpected error occurred. Be safe and return False. IsArrayDynamic = False End Select End Function Private Function IsArrayEmpty(Arr As Variant) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' IsArrayEmpty ' This function tests whether the array is empty (unallocated). Returns TRUE or FALSE. ' ' The VBA IsArray function indicates whether a variable is an array, but it does not ' distinguish between allocated and unallocated arrays. It will return TRUE for both ' allocated and unallocated arrays. This function tests whether the array has actually ' been allocated. ' ' This function is really the reverse of IsArrayAllocated. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Var As Variant Err.Clear On Error Resume Next If IsArray(Arr) = False Then ' we weren't passed an array, return True IsArrayEmpty = True End If ' Attempt to get the UBound of the array. If the array is ' unallocated, an error will occur. Var = UBound(Arr, 1) If (Err.Number <> 0) Or (Var < 0) Then IsArrayEmpty = True Else IsArrayEmpty = False End If End Function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Windows Callback procedures for EnumProps ' These addresses of these procedures are passed to the EnumProps API function. ' Windows will call the procedure passed to EnumProps one time for each property ' in the specified window's property list. These procedures MUST be declared ' exactly as shown. If you change the declarations, you'll crash Excel. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Function ProcEnumPropForFind(ByVal HWnd As Long, ByVal Addr As Long, _ ByVal Data As Long) As Boolean ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ProcEnumPropForFind ' This is the Windows callback function for determining if a property exits. It ' is called by Windows for each property in the property list. We test the string ' value provided to this procedure against the value of PropertyToFind. If we get ' a match, the property exists and the PropertyFound value is set to True, and ' we terminate the enumeration. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim StringName As String Dim Res As Long Dim SLen As Long Dim Pos As Integer ''''''''''''''''''''''''''''''' ' Set the PropertyFound variable ' to False. '''''''''''''''''''''''''''''''' PropertyFound = False ''''''''''''''''''''''''''''''' ' Get the length of the string ' stored at the address Addr. ' This length does not include ' the trailing null character. ''''''''''''''''''''''''''''''' SLen = LStrLen(Addr) ''''''''''''''''''''''''''''''' ' Allocate the StringName buffer. ' The +1 is to make room for the ' trailing null character. ''''''''''''''''''''''''''''''' StringName = String$(SLen + 1, vbNullChar) ''''''''''''''''''''''''''''''''''' ' Copy the string from Addr to the ' StringName buffer variable. ''''''''''''''''''''''''''''''''''' Res = LStrCpy(ByVal StringName, Addr) If Res = 0 Then Debug.Print "An error occurred with LStrCpy.", Err.LastDllError Else ''''''''''''''''''''''''''''''''''''''' ' Trim off the trailing null character. ''''''''''''''''''''''''''''''''''''''' Pos = InStr(1, StringName, vbNullChar) If Pos > 0 Then StringName = Left(StringName, Pos - 1) End If '''''''''''''''''''''''''''''''''''''' ' Compare PropertyName to StringName. ' If they match, set PropertyFound ' to True and terminate the enumeration ' by setting the function's return value ' to False. '''''''''''''''''''''''''''''''''''''' If StrComp(PropertyToFind, StringName, vbTextCompare) = 0 Then PropertyFound = True ProcEnumPropForFind = False Exit Function End If End If ''''''''''''''''''''''''''''' ' Return True to continue the ' enumeration. ''''''''''''''''''''''''''''' ProcEnumPropForFind = True End Function Private Function ProcEnumProp(ByVal HWnd As Long, ByVal Addr As Long, _ ByVal Data As Long) As Boolean ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ProcEnumProp ' This is the callback function for EnumProps. Windows will call ' this function for each Property associated with the HWnd in the ' call to EnumProps. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim StringName As String Dim Res As Long Dim SLen As Long Dim Pos As Integer ''''''''''''''''''''''''''''''' ' Get the length of the string ' stored at the address Addr. ' This length does not include ' the trailing null character. ''''''''''''''''''''''''''''''' SLen = LStrLen(Addr) ''''''''''''''''''''''''''''''' ' Allocate the StringName buffer. ' The +1 is to make room for the ' trailing null character. ''''''''''''''''''''''''''''''' StringName = String$(SLen + 1, vbNullChar) ''''''''''''''''''''''''''''''''''' ' Copy the string from Addr to the ' StringName buffer variable. ''''''''''''''''''''''''''''''''''' Res = LStrCpy(ByVal StringName, Addr) If Res = 0 Then Debug.Print "An error occurred with LStrCpy.", Err.LastDllError Else ''''''''''''''''''''''''''''''''''''''' ' Trim off the trailing null character. ''''''''''''''''''''''''''''''''''''''' Pos = InStr(1, StringName, vbNullChar) If Pos > 0 Then StringName = Left(StringName, Pos - 1) End If Debug.Print CStr(Addr), StringName, CStr(Data) End If ''''''''''''''''''''''''''''' ' Return True to continue the ' enumeration. ''''''''''''''''''''''''''''' ProcEnumProp = True End Function Private Function ProcEnumPropForListAll(ByVal HWnd As Long, ByVal Addr As Long, _ ByVal Data As Long) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ProcEnumPropForListAll ' This is the Windows callback procedure for EnumProps called by GetAllProperties. It ' stores each property name and associated value in a CPropType class instance and ' adds that to the module-level variable ListAllArray. ListAllArray should be Erased ' and ArrayNdx set to 0 prior to calling the EnumProps API function that calls this ' function. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim StringName As String Dim Res As Long Dim SLen As Long Dim Pos As Integer Dim PropType As CPropType ''''''''''''''''''''''''''''''''' ' Get the length of the string. ' This length does not include ' the trailing null character. ''''''''''''''''''''''''''''''''' SLen = LStrLen(Addr) ''''''''''''''''''''''''''''''''' ' Allocate StringName to SLen+1 ' vbNullChars. The +1 is for the ' trailing null character. ''''''''''''''''''''''''''''''''' StringName = String$(SLen + 1, vbNullChar) ''''''''''''''''''''''''''''''''''''''' ' Copy the string from the address Addr ' to the StringName buffer variable. ''''''''''''''''''''''''''''''''''''''' Res = LStrCpy(ByVal StringName, Addr) '''''''''''''''''''''''''''''''''''''' ' Trim to the vbNullChar if necessary. '''''''''''''''''''''''''''''''''''''' Pos = InStr(1, StringName, vbNullChar) If Pos > 0 Then StringName = Left(StringName, Pos - 1) End If ''''''''''''''''''''''''''''''''''''''''' ' Create a new instance of CPropType, ' increment the array index and resize ' the array. Set the last element of ' the array to the new CPropType variable. ''''''''''''''''''''''''''''''''''''''''' Set PropType = New CPropType ArrayNdx = ArrayNdx + 1 ReDim Preserve ListAllArray(1 To ArrayNdx) PropType.Name = StringName PropType.Value = Data Set ListAllArray(UBound(ListAllArray)) = PropType ''''''''''''''''''''''''''''' ' Return True to continue the ' enumeration. ''''''''''''''''''''''''''''' ProcEnumPropForListAll = True End Function
|
||
Created By Chip Pearson and
Pearson Software Consulting, LLC
This Page:
Updated: November 06, 2013
MAIN PAGE
About This Site
Consulting
Downloads
Page Index
Search
Topic Index
What's New
Links
Legalese And Disclaimers
chip@cpearson.com
© Copyright 1997-2007 Charles H. Pearson