【发布时间】：2015-03-23 15:17:48
【问题描述】：
我需要将一系列宏分发给我的团队，以便在多个不同的工作簿上使用。过去，我会为人们手动“安装”宏到他们的个人工作簿空间中，但现在使用宏的人数太多了。
我想创建一个工作簿，其中包含我想复制到 PERSONAL.XLSB 的宏，然后有一个将它们复制到那里的按钮。 （将它们放在顶部的快速访问工具栏上的奖励积分）
例子：
我有一个名为macroCopyTestBook.xlsx 的工作簿，我想将copyThisModule 模块复制到PERSONAL.XLSB。我已经尝试回答类似的问题并将其用于此目的，但它不起作用。我明白了：
copyTest() 的第一行需要运行时错误 424 对象。
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
【问题讨论】：
-
您是否考虑过创建一个包含个人工作簿所有功能的加载项？
-
如果您提供代码，我们可以帮助您找出问题所在。
-
究竟是什么不起作用？
-
制作一个宏将工作簿保存为个人文件可能更容易
-
我同意凯尔的观点！插件维护起来会简单得多。