Question

我有一系列宏，我需要能够分发给我的团队，以便在几个不同的工作簿上使用。在过去，我会手动为人们“安装”宏进入他们的个人工作簿空间，但现在这需要花费太多时间来处理使用宏的人数。

我想创建一个包含我想要复制到PERSONAL.XLSB的宏的工作簿，然后有一个复制它们的按钮。（将它们放在顶部的快速访问工具栏上的奖励积分）

示例：

我有一个名为macroCopyTestBook.xlsx的工作簿，我想将copyThisModule模块复制到PERSONAL.XLSB。我已经尝试回答类似的问题并将其用于此但它不起作用。我明白了：

运行时错误424对象在copyTest（）的第一行上需要。

Sub copyTest()
If (CopyModule("copyThisModule", macroCopyTestBook.xlsx.VBProject, PERSONAL.XLSB, False)) Then
    MsgBox "Copy went!"
Else
    MsgBox "Copy failed!"
End If

End Sub

Function CopyModule(ModuleName As String, _
                FromVBProject As VBIDE.VBProject, _
                ToVBProject As VBIDE.VBProject, _
                OverwriteExisting As Boolean) As Boolean

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CopyModule
' This function copies a module from one VBProject to another.
'It returns True if successful or False if an error occurs.
' ' Parameters: ' --------------------------------
' FromVBProject The VBProject that contains the module to be copied. '
' ToVBProject The VBProject into which the module is ' to be copied. '
' ModuleName The name of the module to copy. '
' OverwriteExisting If True, the VBComponent named ModuleName in ToVBProject     will be removed before
' importing the module.
'If False and a VBComponent named ModuleName exists in ToVBProject, the code will return ' False.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim VBComp As VBIDE.VBComponent
Dim FName As String
Dim CompName As String
Dim S As String
Dim SlashPos As Long
Dim ExtPos As Long
Dim TempVBComp As VBIDE.VBComponent

'''''''''''''''''''''''''''''''''''''''''''''
' Do some housekeeping validation.
'''''''''''''''''''''''''''''''''''''''''''''
If FromVBProject Is Nothing Then
    CopyModule = False
    Exit Function
End If

If Trim(ModuleName) = vbNullString Then
    CopyModule = False
    Exit Function
End If

If ToVBProject Is Nothing Then
    CopyModule = False
    Exit Function
End If

If FromVBProject.Protection = vbext_pp_locked Then
    CopyModule = False
    Exit Function
End If

If ToVBProject.Protection = vbext_pp_locked Then
    CopyModule = False
    Exit Function
End If

On Error Resume Next
Set VBComp = FromVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
    CopyModule = False
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''
' FName is the name of the temporary file to be
' used in the Export/Import code.
''''''''''''''''''''''''''''''''''''''''''''''''''''
FName = Environ("Temp") & "\" & ModuleName & ".bas"
If OverwriteExisting = True Then
    ''''''''''''''''''''''''''''''''''''''
    ' If OverwriteExisting is True, Kill
    ' the existing temp file and remove
    ' the existing VBComponent from the
    ' ToVBProject.
    ''''''''''''''''''''''''''''''''''''''
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
        Err.Clear
        Kill FName
        If Err.Number <> 0 Then
            CopyModule = False
            Exit Function
        End If
    End If
    With ToVBProject.VBComponents
        .Remove .Item(ModuleName)
    End With
Else
    '''''''''''''''''''''''''''''''''''''''''
    ' OverwriteExisting is False. If there is
    ' already a VBComponent named ModuleName,
    ' exit with a return code of False.
    ''''''''''''''''''''''''''''''''''''''''''
    Err.Clear
    Set VBComp = ToVBProject.VBComponents(ModuleName)
    If Err.Number <> 0 Then
        If Err.Number = 9 Then
            ' module doesn't exist. ignore error.
        Else
            ' other error. get out with return value of False
            CopyModule = False
            Exit Function
        End If
    End If
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''
' Do the Export and Import operation using FName
' and then Kill FName.
''''''''''''''''''''''''''''''''''''''''''''''''''''
FromVBProject.VBComponents(ModuleName).Export Filename:=FName

'''''''''''''''''''''''''''''''''''''
' Extract the module name from the
' export file name.
'''''''''''''''''''''''''''''''''''''
SlashPos = InStrRev(FName, "\")
ExtPos = InStrRev(FName, ".")
CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1)

''''''''''''''''''''''''''''''''''''''''''''''
' Document modules (SheetX and ThisWorkbook)
' cannot be removed. So, if we are working with
' a document object, delete all code in that
' component and add the lines of FName
' back in to the module.
''''''''''''''''''''''''''''''''''''''''''''''
Set VBComp = Nothing
Set VBComp = ToVBProject.VBComponents(CompName)

If VBComp Is Nothing Then
    ToVBProject.VBComponents.Import Filename:=FName
Else
    If VBComp.Type = vbext_ct_Document Then
        ' VBComp is destination module
        Set TempVBComp = ToVBProject.VBComponents.Import(FName)
        ' TempVBComp is source module
        With VBComp.CodeModule
            .DeleteLines 1, .CountOfLines
            S = TempVBComp.CodeModule.Lines(1,         TempVBComp.CodeModule.CountOfLines)
            .InsertLines 1, S
        End With
        On Error GoTo 0
        ToVBProject.VBComponents.Remove TempVBComp
    End If
End If
Kill FName
CopyModule = True

End Function

Answer 1

macroCopyTestBook.xlsx应为Workbooks("macroCopyTestBook").VBProject
和
PERSONAL.XLSB应为Workbooks("PERSONAL.XLSB").VBProject

所以你的功能应该是这样的：

CopyModule("copyThisModule", Workbooks("macroCopyTestBook.xlsx").VBProject, Workbooks("PERSONAL.XLSB").VBProject, False)

您无法直接从其名称引用工作簿对象，因此您需要使用Workbooks()方法让VBA知道您所指的内容。

Answer 2

您还可以使用内置工具Application.OrganizerCopy。对不起，这只是在Word ..

VBA：将工作表宏复制到个人工作簿

2 个答案: