[已解决]加个另存为

乐乐2006201506

        在下面代码中加入一段另存为的代码，保存路径“C:\Users\Administrator\Desktop\写入代码另存＼花名册测试文件\”，而不是红色代码直接保存在原文件中。谢谢！
Sub test()
    p = "C:\Users\Administrator\Desktop\写入代码另存＼花名册测试文件\"
    f = Dir(p & "*.xls")
    Do While f <> ""
        Workbooks.Open p & f
        With ActiveWorkbook.VBProject.VBComponents("thisworkbook").CodeModule
            .InsertLines 1, "sub test()"
            .InsertLines 2, "msgbox ""just a test""" '双引号中的双引号,2个代表1个.
            .InsertLines 3, "end sub"
        End With
        ActiveWorkbook.Close True
        f = Dir
    Loop
End Sub

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-6-22 21:32

乐乐2006201506 发表于 2016-6-22 20:37
如果能实现插入文件夹及子文件夹中所有工作簿则更好。

试试这个：

1. Sub test()
   
2.     p = "C:\Users\Administrator\Desktop\花名册测试文件"
   
3.     f = Dir(p & "*.xls")
   
4.     Do While f <> ""
   
5.         Workbooks.Open p & f
   
6.         With ActiveWorkbook.VBProject.VBComponents("thisworkbook").CodeModule
   
7.             .InsertLines 1, "sub test()"
   
8.             .InsertLines 2, "msgbox ""just a test""" '双引号中的双引号,2个代表1个.
   
9.             .InsertLines 3, "end sub"
   
10.         End With
    
11.         ActiveWorkbook.SaveAs Filename:=p & Replace(f, ".xls", ".xlsm"), FileFormat:=52
    
12.         ActiveWorkbook.Close True
    
13.         f = Dir
    
14.     Loop
    
15. End Sub

复制代码

跳转到最佳答案楼层

老司机带带我

没明白你的意思，你到底是要把
Sub test()
MsgBox "just a test"
End Sub
这个过程插入到那几个花名册工作簿中还是写入代码这个工作簿中？
如果是写入花名册中你的代码不是已经实现了？

乐乐2006201506

        将代码写入所有工作簿的thisworkbook中，我的代码保存2003版的有宏也不用另存，如果是2007版以上的有宏的话就必须存为.xlsm。所以要另存。现在要实现另存2007版以上的工作簿为同名的“.xlsm”。

乐乐2006201506

如果能实现插入文件夹及子文件夹中所有工作簿则更好。

老司机带带我

乐乐2006201506 发表于 2016-6-22 20:37
如果能实现插入文件夹及子文件夹中所有工作簿则更好。

试试这个：

1. Sub test()
   
2.     p = "C:\Users\Administrator\Desktop\花名册测试文件"
   
3.     f = Dir(p & "*.xls")
   
4.     Do While f <> ""
   
5.         Workbooks.Open p & f
   
6.         With ActiveWorkbook.VBProject.VBComponents("thisworkbook").CodeModule
   
7.             .InsertLines 1, "sub test()"
   
8.             .InsertLines 2, "msgbox ""just a test""" '双引号中的双引号,2个代表1个.
   
9.             .InsertLines 3, "end sub"
   
10.         End With
    
11.         ActiveWorkbook.SaveAs Filename:=p & Replace(f, ".xls", ".xlsm"), FileFormat:=52
    
12.         ActiveWorkbook.Close True
    
13.         f = Dir
    
14.     Loop
    
15. End Sub

复制代码