引用从工作表代码添加全局变量

时间:2015-04-29 16:19:37

标签: excel excel-vba vba

我正在构建一个Excel Addin,它在sub中声明了一些Public变量。首次使用Addin时,它会从Addin(ThisWorkBook)复制一些工作表 到用户的工作簿(ActiveWorkBook)。这些工作表中包含一些工作表事件。

问题:ActiveWorkBook工作表事件子需要引用ThisWorkBoook中定义的公共变量,但似乎无法找到它们。我想因为他们在不同的工作簿中。但是在这种附加情况下,肯定有某种方法可以做到这一点吗?

具体示例:模块Module1中的GlobalAddin.xlam声明

Option Explicit
Public TestMe As Integer

然后

Public Sub RunSub()
TestMe = 10
MsgBox "The Addin says that TestMe is " & TestMe
End Sub

并从ThisWorkBook._Open()事件中调用RunSub。

GlobalAddin.xlam是一个活跃的插件。现在在Sheet1中的另一个工作簿Book2.xlm中我们已经

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox "The Worksheet says TestMe is " & TestMe
End Sub

现在打开Book2.xlm。一个对话框报告TestMe的值为10(这来自xlam workbook_open甚至调用RunSub。)但是然后单击Book2中的Sheet1会导致变量未定义错误,说明TestMe未定义。

所以这是有道理的,但是我如何在Book2中的工作表事件中访问TestMe的值?

(编辑:我想我可以通过ActiveWorkBook中的(隐藏)工作表传递变量,但这看起来有点笨拙。有更好的方法吗?)

2 个答案:

答案 0 :(得分:3)

你能不能做到以下几点?

  1. 创建一个包含在模块中声明的字段的插件。

    公共TestMe为整数

  2. 还在同一个addin模块中声明一个公共函数以获取字段值。

    public Function GetTestMe()为整数 GetTestMe = TestMe 结束功能

  3. 现在在同一个Excel应用程序中的任何其他工作簿中,后期绑定调用以获取值。

    public Sub TestAddinCall() Dim x as Integer x = Application.run(" GetTestMe") End Sub

  4. 这显然是后期限制,但可能是最简单的方法。

答案 1 :(得分:1)

我之前解决过类似的问题,不仅要将工作表复制到新工作簿中(每张工作表附带支持代码),还要将VBA模块导入新工作簿。显然,VBA模块可以定义任何公共全局变量,并使它们存在于该工作簿中。在为工作簿安装加载项并且您希望这些公共变量“本地”到加载项启用的工作簿时,这很重要。

在某些时候,您必须将VBA模块导出到文本文件:

Sub ExportAllModulesAndClasses()
    On Error GoTo Err_ExportAllModulesAndClasses
    'Purpose:   Connects to the current project and exports each of the VBA
    '           components to an external, text-based file. File extensions
    '           are automatically selected based on the type of the component.
    'Return:    n/a
    'Author:    PeterT
    Dim i As Integer
    Dim sourceCode As Object
    Dim filename As String

    i = 0
    For Each sourceCode In Application.VBE.ActiveVBProject.VBComponents
        filename = CHOOSE_YOUR_DIRECTORY_PATH_HERE & sourceCode.name & GetFileExtension(sourceCode)
        Debug.Print "Exported: " & filename
        sourceCode.Export filename
        i = i + 1
    Next
    Debug.Print "Export complete: " & i & " source code files created from this application"

Exit_ExportAllModulesAndClasses:
    Exit Sub

Err_ExportAllModulesAndClasses:
    MsgBox "In ExportAllModulesAndClasses: " & Err.Number & " - " & Err.Description, vbOKOnly
    Resume Exit_ExportAllModulesAndClasses
End Sub

Public Function GetFileExtension(vbComp As Object) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the appropriate file extension based on the Type of
' the VBComponent.
' based on: http://www.cpearson.com/excel/vbe.aspx
'
' Type property constants:
' vbext_ct_StdModule       =   1  Standard Module
' vbext_ct_ClassModule     =   2  Class Module
' vbext_ct_MSForm          =   3  Microsoft Form
' vbext_ct_ActiveXDesigner =  11  ActiveX Designer
' vbext_ct_Document        = 100  Document Module
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Select Case vbComp.Type
        Case 2                        'class
            GetFileExtension = ".cls"
        Case 100                      'document
            GetFileExtension = ".cls"
        Case 3                        'form
            GetFileExtension = ".frm"
        Case 1                        'standard module
            GetFileExtension = ".bas"
        Case Else
            GetFileExtension = ".bas"
    End Select
End Function

然后,当您的加载项安装时,您可以将模块导入新工作簿:

Sub ImportVBAProjectFiles()
On Error GoTo Err_ImportVBAProjectFiles
    'Purpose:   Uses the constants defined above to access a specific
    '           directory. All files within that directory will be added as
    '           a module, class, form, etc to this application project.
    'Return:    n/a
    'Author:    PeterT
    Dim i As Integer
    Dim name As Variant
    Dim filenames As New Collection

    '--- build up an array of all the files (modules, forms, classes, etc)
    '    that will be imported
    Call FillDir(filenames, CHOOSE_YOUR_DIRECTORY_PATH_HERE , "*.*", False)

    '--- add each item to this project
    i = 0
    For Each name In filenames
        Application.VBE.ActiveVBProject.VBComponents.Import CStr(name)
        Debug.Print "Imported: " & name
        i = i + 1
    Next

Exit_ImportVBAProjectFiles:
    Exit Sub

Err_ImportVBAProjectFiles:
    MsgBox "In ImportVBAProjectFiles: " & Err.Number & " - " & Err.Description, vbOKOnly
    Resume Exit_ImportVBAProjectFiles
End Sub

Private Function FillDir(colDirList As Collection, ByVal strFolder As String, _
                         strFileSpec As String, bIncludeSubfolders As Boolean)
    'Build up a list of files, and then add add to this list, any additional folders
    'from:      http://allenbrowne.com/ser-59.html
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Build collection of additional subfolders.
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop
        'Call function recursively for each subfolder.
        For Each vFolderName In colFolders
            Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
        Next vFolderName
    End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
    'from:      http://allenbrowne.com/ser-59.html
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function