替换代码的问题

dfshm

附件 替换代码附件.rar (905.89 KB, 下载次数: 8)

2024-3-16 16:30 上传

点击文件名下载附件

谢谢老师！

limonet

为了效率、空间、友善。
￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥
与本附件同一目录下，有工作薄若干个。
工作薄格式：xlsm
每一个工作薄里面都有代码，在模块1中。
本附件模块1中，也有代码。
述求：将本附件 模块1中的代码，替换掉各工作薄 模块1中的代码。
￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥

风雨声点滴

Sub ReplaceModule1Content()
    Dim SourceLines As String
    Dim MyFolder As String
    Dim MyFile As String
    Dim wb As Workbook
    Dim vbProj As Object
    Dim vbComp As Object
    Dim ThisProj As Object
    Dim ThisComp As Object

    ' 保存当前工作簿中模块1的代码
    Set ThisProj = ActiveWorkbook.VBProject
    Set ThisComp = ThisProj.VBComponents("模块1") '要替换成的模块名字
    SourceLines = ThisComp.CodeModule.Lines(1, ThisComp.CodeModule.CountOfLines)

    ' 指定你的文件夹路径(请根据实际情况修改路径)
    MyFolder = "E:\浏览器下载\替换代码附件\"

    ' 查找该文件夹中的所有.xlsm文件
    MyFile = Dir(MyFolder & "*.xlsm")
    While MyFile <> ""
        ' 打开工作簿
        Set wb = Workbooks.Open(MyFolder & MyFile)

        ' 获取VBA项目
        Set vbProj = wb.VBProject
        Set vbComp = vbProj.VBComponents("模块1") '被替换模块名字

        ' 清除并替换模块1的代码
        With vbComp.CodeModule
            .DeleteLines 1, .CountOfLines
            .InsertLines 1, SourceLines
        End With

        ' 保存并关闭工作簿
        wb.Close SaveChanges:=True

        ' 获取下一个文件
        MyFile = Dir
    Wend
End Sub

风雨声点滴

回复你了  你换成你的路径就好了

dfshm

风雨声点滴 发表于 2024-3-16 16:55
回复你了  你换成你的路径就好了

老师你好，谢谢帮助。问一下，直接把代码放模块2里行吗？

风雨声点滴

dfshm 发表于 2024-3-16 17:13
老师你好，谢谢帮助。问一下，直接把代码放模块2里行吗？

对的，就是那样

dfshm

风雨声点滴 发表于 2024-3-16 17:15
对的，就是那样

老师你好，试了一下，没有反应。

风雨声点滴

dfshm 发表于 2024-3-16 17:25
老师你好，试了一下，没有反应。

名字、路径修改了吗？

风雨声点滴

我这里完美运行，你要先把要替换的文件先放一起，然后把替换掉文件拷贝出文件夹放在 桌面，然后在模块2里面把这个代码粘贴进去，等他运行玩就全部替换好了。