我有一些VBA代码需要复制到很多工作表（它的事件处理，因此它位于工作表而不是模块中）。
问题：是否可以编写一个宏，允许我选择我需要修改的所有工作簿，然后自动将代码写入所有选定工作簿的每张工作表中？
答案 0 :(得分：5)
没有直接的方法将模块从一个项目复制到另一个项目。要完成此任务，必须从Source VBProject导出模块，然后将该文件导入Destination VBProject。下面的代码将执行此操作。
函数声明是：
Function CopyModule(ModuleName As String, _
FromVBProject As VBIDE.VBProject, _
ToVBProject As VBIDE.VBProject, _
OverwriteExisting As Boolean) As Boolean
ModuleName是您要从一个项目复制到另一个项目的模块的名称。
FromVBProject是包含要复制的模块的VBProject。这是来源VBProject。
ToVBProject是要复制模块的VBProject。这是目的地VBProject。
OverwriteExisting表示如果ModuleName中已存在ToVBProject该怎么办。如果是True，现有的VBComponent将从ToVBProject中删除。如果这是False且VBComponent已存在，则该函数不执行任何操作并返回False。
如果成功，函数将返回True;如果发生错误，则返回False。如果满足以下任何条件，该函数将返回False：
FromVBProject is nothing.
ToVBProject is nothing.
ModuleName is blank.
FromVBProject is locked.
ToVBProject is locked.
ModuleName does not exist in FromVBProject.
ModuleName exists in ToVBProject and OverwriteExisting is False.
完整的代码如下所示：
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
答案 1 :(得分：0)
你需要调查VBComponents来完成这类任务
首先需要激活名为“Microsoft Visual Basic for Applications Extensibility”的引用
请尝试以下代码：
Sub Test_InsertCode()
Dim Commands As String
Commands = Chr(13) & _
"Private Sub TestNewCode()" & Chr(13) & _
" MsgBox ""You Win !!""" & Chr(13) & _
"End Sub"
Dim VBComps As VBComponents
Set VBComps = ThisWorkbook.VBProject.VBComponents
Dim VBComp As VBComponent
Dim VBCodeMod As CodeModule
Dim oSheet As Worksheet
For Each oSheet In ThisWorkbook.Worksheets
Set VBComp = VBComps(oSheet.CodeName)
Set VBCodeMod = VBComp.CodeModule
InsertCode VBCodeMod, Commands
Next oSheet
'Here's a quick example of how to insert code in a new Module
Set VBComp = VBComps.Add(vbext_ct_StdModule)
InsertCode VBComp.CodeModule, Commands
End Sub
Private Function InsertCode(VBCodeMod As CodeModule, Commands As String)
Dim LineNum As Long
With VBCodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, Commands
End With
End Function
NB。当你在中断模式下运行它（或逐行？）时，它会在复制代码后立即生成错误。你需要一次运行它。
此代码适用于Excel 2003，在更高版本上运行时可能会出现一些我不知道的安全问题。
答案 2 :(得分：0)
这不会解决工作表，事件部分，但这是将模块从一个工作簿移动到另一个工作簿的简单解决方案。
注意 - 您需要打开上面提到的“Microsoft Visual Basic for Applications Extensibility”参考。
简而言之，代码将起作用（没有所有内务验证）。显然，你可以获得更多的发烧友和错误证明/处理，但这是基础知识。该函数将模块从FromVBProject导出到文件目录，然后导入到ToVBProject。
Function CopyModule (ModuleName as String, FromVBProject as VBIDE.VBProject, _
ToVBProject as VBIDE.VBProject, _
FileLocation as String) as Boolean
Dim fileDirectory as String
fileDirectory = filelocation & ModuleName & ".bas"
FromVBProject.VBComponents.Item(ModuleName).Export fileDirectory
ToVBProject.Import fileDirectory
Kill fileDirectory
CopyModule = True
End Function
Sub CopyModuleToOtherWorkbook()
Dim destinationWorkbook as Workbook
Set destinationWorkbook = Workbooks("destiationWorkbook.xlsm")
CopyModule "TestModule", ThisWorkbook.VBProject, destinationWorkbook.VBProject, "C:\my documents\macros\"
'Assuming you want to save the workbook you just copied the module to
destinationWorkbook.SaveAs C:\my documents\macros\ & desintationWorkbook.Name, xlOpenXMLWorkbookMacroEnabled
End sub