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

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

请帮忙，因为我说错了 “未设置对象变量或带块变量。错误＃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并发送一些反馈。

更改事件过程的类型

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

代码

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

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

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

解决方法

更改事件过程的类型

相关推荐