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

Question

请帮忙，因为我说错了 “对象变量或块变量未设置。错误#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

Answer 1

请更改：

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

与：

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

通配符必须在字符串内。

但我不明白你的代码怎么能忽略这个。应该（首先）在上述行中提出错误...

请尝试在讨论的行之后立即添加此代码行：

Debug.Print strCurrentFile: Stop

代码停止时 return 是什么意思？是真实的工作簿全名吗？

我建议，当尝试修改代码模块中的某些内容时，添加对“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)

return在Immediate WindowTrue如果找到要替换的行并进行了替换

请测试它并发送一些反馈。

第二次编辑:

以下解决方案将使用具有正确“ThisWorkbook”代码模块的工作簿，该代码模块将被复制到strPath文件夹中的所有工作簿。您必须注意 strCurrentFile 值。它可能允许 .xlsx 文件，这些文件不能用 VBA inside...

保存

以下解决方案需要参考 '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 并发送一些反馈。

Answer 2

更改事件过程的类型

这样的事情可能是一个解决方案。希望事件过程从第一行开始。

代码

Option Explicit

Sub CopyCode()

    Const ReplaceString As String = _
      "Private Sub Workbook_BeforeClose(Cancel As Boolean)"
    
    Dim wb As Workbook
    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)
        ' Debug.Print wb.FullName
        Set VBP = wb.VBProject
        Set VBC = VBP.VBComponents(wb.CodeName)
        Set CM = VBC.CodeModule
        
        Application.DisplayAlerts = False
        CM.ReplaceLine 1, ReplaceString
        wb.Close SaveChanges:=True
        Application.DisplayAlerts = False
        
        strCurrentFile = Dir
    
    Loop
    
    MsgBox "Done"

End Sub

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

I'm trying to change event procedure s for multiple workbooks?

excel

vba

loops

runtime-error

event-handling

更改事件过程的类型