VBA：将工作表macros复制到个人工作簿
我有一系列的macros，我需要能够分发给我的团队使用几个不同的工作簿。 在过去，我会手动地为个人“安装”macros到他们的个人工作簿空间，但是这对于使用这些macros的人数来说现在需要很多时间。
我想创build一个工作簿，该macros具有要复制到PERSONAL.XLSBmacros，然后有一个将它们复制到其中的button。 （把它们放在顶部的快速访问工具栏上的奖励点数）
例：
我有一个名为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
macroCopyTestBook.xlsx应该是Workbooks("macroCopyTestBook").VBProject
和
PERSONAL.XLSB应该是Workbooks("PERSONAL.XLSB").VBProject
所以你的函数应该是这样的：
CopyModule("copyThisModule", Workbooks("macroCopyTestBook.xlsx").VBProject, Workbooks("PERSONAL.XLSB").VBProject, False)
您不能直接从名称中引用工作簿对象，所以您需要使用Workbooks()方法让VBA知道您所指的是什么。
您也可以使用内置工具Application.OrganizerCopy 。 对不起，这只是在Word中。