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.

SetProperty

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.

GetProperty

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.


GetAllProperties

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
PropertyExists
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.


RemoveProperty

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