excel - 我正在尝试更改多个工作簿的事件过程？

请帮忙，因为我说错了
“未设置对象变量或带块变量。
错误＃91
卡在wb.close行中
如果需要更改多个工作簿的事件过程，请提供帮助
任何想法

    Sub CopyCode()

  Dim wb As Workbook

  Dim strInput
  Dim VBP As Object, VBC As Object, CM As Object
  Dim strpath As String, strCurrentFile As String


  strpath = "C:\Users\Basem Lap\Desktop\test\"
  strCurrentFile = Dir(strpath & "*.xls"*)






  Do While strCurrentFile <> ""
    Set wb = Workbooks.Open(strpath & strCurrentFile)
    Set VBP = wb.VBProject
    Set VBC = VBP.VBComponents(wb.CodeName)
    Set CM = VBC.CodeModule


    Application.DisplayAlerts = False


    Application.DisplayAlerts = False

    With wb.VBProject.VBComponents("ThisWorkbook").CodeModule
     .ReplaceLine 1, "Private Sub Workbook_BeforeClose(Cancel As Boolean)"

    End With




    wb.Close savechanges:=True
    Application.DisplayAlerts = False

    Set wb = Nothing
    strCurrentFile = Dir
  Loop

  MsgBox "Done"
End Sub

最佳答案

请更换:

strCurrentFile = Dir(strpath & "*.xls"*)

与:

strCurrentFile = Dir(strpath & "*.xls*")

字符串中必须包含通配符。
但是我不明白您的代码将如何传递。该错误(首先)应在上述行中引发...
请尝试在讨论的行之后立即添加此代码行:

Debug.Print strCurrentFile: Stop

代码停止时返回什么？它是真实的工作簿全名吗？
我建议在尝试修改代码模块中的某些内容时，添加对“Microsoft Visual Basic for Applications Extensibility xx”库的引用，并适当地声明所使用的变量。您将从智能建议中受益，这可能会有所帮助。
编辑:
如果要替换的代码行是第一行，则您现有的代码应将其替换为所需的代码行。如果不是，请使用下一个代码，该代码将首先搜索要替换的代码，然后在要替换的位置进行替换:

Function ReplaceCodeLine(wb As Workbook, strModule As String, strSearch As String, strReplace As String) As Boolean
 Dim VBProj As Object, VBComp As Object, CodeMod As Object
 Dim startL As Long, endL As Long
 Dim strCLine As String, boolFound As Boolean

    Set VBProj = wb.VBProject
    Set VBComp = VBProj.VBComponents(strModule)
    Set CodeMod = VBComp.CodeModule
    startL = 1
    With CodeMod
        endL = .CountOfLines
        boolFound = .Find(Target:=strSearch, StartLine:=startL, StartColumn:=1, _
              EndLine:=endL, EndColumn:=255, wholeword:=True, MatchCase:=False, _
                                                             patternsearch:=False)

        If boolFound Then
            strCLine = Replace(CodeMod.Lines(startL, 1), strSearch, _
                                     strReplace, Compare:=vbTextCompare)
            .ReplaceLine startL, strCLine
            ReplaceCodeLine = True
        Else
            ReplaceCodeLine = False
        End If
    End With
End Function

通过将上述函数复制到标准模块中并替换下一部分，可以从您的代码中调用它:

With wb.VBProject.VBComponents("ThisWorkbook").CodeModule
     .ReplaceLine 1, "Private Sub Workbook_BeforeClose(Cancel As Boolean)"

End With

与此:

Dim strExist as String, strToReplace as String
strExist = "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)"
strToReplace = "Private Sub Workbook_BeforeClose(Cancel As Boolean)"
Debug.Print ReplaceCodeLine(wb, "ThisWorkbook", strExist, strToReplace)

如果找到了要替换的行并进行了替换，它将返回Immediate Window True。
请对其进行测试并发送一些反馈。
编辑第二次:
以下解决方案将使用一个工作簿，该工作簿具有正确的“ThisWorkbook”代码模块，该模块将复制到strPath文件夹中的所有工作簿中。您必须注意strCurrentFile值。它可能允许.xlsx文档，而无法使用VBA将其保存在内部...

以下解决方案需要对“Microsoft Visual for Applications Extensibility 5.3”的引用。为了以编程方式添加它，请在标准模块中复制下一个代码并运行它:

Sub addExtenssibilityReference()
   ThisWorkbook.VBProject.References.AddFromGuid _
        GUID:="{0002E157-0000-0000-C000-000000000046}", _
        Major:=5, Minor:=3
End Sub

您的现有代码应替换为下一个:

Sub CopyThisWorkbookCode()
'It needs a reference to 'Microsoft Visual for Applications Extensibility 5.3'.
 Dim VBProjSource As VBIDE.VBProject, VBCompSource As VBIDE.VBComponent
 Dim VBProjTarget As VBIDE.VBProject, wb As Workbook, strCode As String

 Set VBProjSource = ThisWorkbook.VBProject 'or another (open) workbook keeping
                                           'the ThisWorkbook code to be copyed from
 Set VBCompSource = VBProjSource.VBComponents("ThisWorkbook")
 'all ThisWorkbook module code copied as string:
 strCode = VBCompSource.CodeModule.Lines(1, VBCompSource.CodeModule.CountOfLines)

  Dim strPath As String, strCurrentFile As String

  strPath = "C:\Users\Basem Lap\Desktop\test\"
  strCurrentFile = Dir(strPath & "*.xls*")

  Application.EnableEvents = False: Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  Do While strCurrentFile <> ""
    Set wb = Workbooks.Open(strPath & strCurrentFile)
    Set VBProjTarget = wb.VBProject

    impThisWorkbookModule VBProjTarget, strCode

    wb.Close savechanges:=True
    strCurrentFile = Dir
  Loop

  Application.EnableEvents = True: Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic

  MsgBox "Done"
End Sub

请注意VBProjSource选择。在上面的代码中，我使用了保留此代码的工作簿。您可以使用另一个:Set VBProjSource = Workbooks("Model Workbook").VBProject。

在上面的代码下面复制下一个函数:

Function impThisWorkbookModule(VBProjT As VBIDE.VBProject, strCode As String)
  Dim VBCompTarget As VBIDE.VBComponent

  Set VBCompTarget = VBProjT.VBComponents("ThisWorkbook")

    With VBCompTarget.CodeModule
        .DeleteLines 1, .CountOfLines
        .InsertLines 1, strCode
    End With
End Function

运行CopyThisWorkbookCode Sub并发送一些反馈。

关于excel - 我正在尝试更改多个工作簿的事件过程？，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/64512345/