如何插入一个macros（我做）在1000个不同的Excel中没有这个macros

我在perforce中有一个shered文件夹，我有很多的子文件夹，里面有1000个以上的excel文件，我正在为我使用的特定macros运行下面的代码（这改变了wb中的东西）。 我也需要在这些文件中应用这个macros。 我的意思是我希望那个macros可以在每个excel文件里面运行，在其他计算机上重新使用的文件上运行的代码是可能的？

Sub ProcessFiles() Dim objFolder As Object Dim objFile As Object Dim objFSO As Object Dim MyPath As String Dim myExtension As String Dim FldrPicker As FileDialog Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then Exit Sub ' < can use Exit Sub instead of GoTo MyPath = .SelectedItems(1) End With Application.DisplayAlerts = False ' <-- add this line Application.ScreenUpdating = False Set objFSO = CreateObject("Scripting.FileSystemObject") Call GetAllFiles(MyPath, objFSO) Call GetAllFolders(MyPath, objFSO) ' restore default settings Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Complete." End Sub Sub GetAllFiles(ByVal strPath As String, ByRef objFSO As Object) Dim objFolder As Object Dim objFile As Object Set objFolder = objFSO.GetFolder(strPath) For Each objFile In objFolder.Files DoWork objFile.Path Next objFile End Sub Sub GetAllFolders(ByVal strFolder As String, ByRef objFSO As Object) Dim objFolder As Object Dim objSubFolder As Object Set objFolder = objFSO.GetFolder(strFolder) For Each objSubFolder In objFolder.subfolders Call GetAllFiles(objSubFolder.Path, objFSO) Call GetAllFolders(objSubFolder.Path, objFSO) Next objSubFolder End Sub Sub DoWork(strFile As String) Dim wb As Workbook If Right(strFile, 4) = ".xls" Then Set wb = Workbooks.Open(Filename:=strFile) With wb 'Do your work here ...... .Close True End With End If End Sub 

Answer 1

正如上面的评论所解释的那样，你可以把你的代码放在一个.bas模块文件中，然后通过VBE将它导入到每个Excel文件中。

 workbook.VBProject.VBComponents.Import ("mymodule.bas") 

小心你的Excel电子表格不受密码保护！

Answer 2

你也可以考虑使用一个AddIn，然后你可以加载AddIn以使其他代码可用，所以ProcessFiles将被编码为MyAddIn.ProcessFiles。