[已解决]一个“会者不难难者不会”的问题

ztccsj

诸位，请看附件，谢谢

需求说明：1、对于一个不会VBA的人，可以通过点击“拷贝备份到新文件”的按钮，将备份代码自动拷贝到“新文件”中，并建立同样的”备份”按钮
2、新文件通过浏览目录来指定

最佳答案

月排行榜 / 总排行榜

suye1010

2012-8-9 22:14

1. Sub AddBackupToFile()
   
2.     Dim str As String
   
3.     str = "Sub 备份()" & vbCrLf & _
   
4.           "Dim wb As Workbook" & vbCrLf & _
   
5.           "Set wb = ThisWorkbook" & vbCrLf & _
   
6.           "On Error Resume Next" & vbCrLf & _
   
7.           "s1$ = ThisWorkbook.FullName '保存当前文件的全路径及名称" & vbCrLf & _
   
8.           "Application.DisplayAlerts = False" & vbCrLf & _
   
9.           "wb.SaveAs ([a1] & """"& ActiveWindow.Caption)" & vbCrLf & _
   
10.           "wb.SaveAs s1" & vbCrLf & _
    
11.           "End Sub"
    
12.     Dim WK As Workbook
    
13.     Application.DisplayAlerts = False
    
14.     With Application.FileDialog(msoFileDialogFilePicker)
    
15.         .AllowMultiSelect = False
    
16.         .Show
    
17.         If .SelectedItems.Count = 0 Then Exit Sub '未选择文件
    
18.         Set WK = Application.Workbooks.Open(.SelectedItems(1))
    
19.     End With
    
20.     WK.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString (str)
    
21.     With WK.Sheets(1).Buttons.Add(500, 10, 30, 18)
    
22.         .OnAction = "备份"
    
23.         .Characters.Text = "备份"
    
24.     End With
    
25.     WK.Close True
    
26.     Application.DisplayAlerts = True
    
27. End Sub

复制代码

跳转到最佳答案楼层

无聊的疯子

对于想来解决问题的人来说,搞不懂楼主的意思是最难的!!

ztccsj

无聊的疯子 发表于 2012-8-9 15:50
对于想来解决问题的人来说,搞不懂楼主的意思是最难的!!

看这样你能明白了吗

ztccsj

能不能实现呢？我试图录制一个宏，结果发现，好像宏只能记录工作表中的动作，对于vba编辑器里面的动作无记录啊

suye1010

1. Sub AddBackupToFile()
   
2.     Dim str As String
   
3.     str = "Sub 备份()" & vbCrLf & _
   
4.           "Dim wb As Workbook" & vbCrLf & _
   
5.           "Set wb = ThisWorkbook" & vbCrLf & _
   
6.           "On Error Resume Next" & vbCrLf & _
   
7.           "s1$ = ThisWorkbook.FullName '保存当前文件的全路径及名称" & vbCrLf & _
   
8.           "Application.DisplayAlerts = False" & vbCrLf & _
   
9.           "wb.SaveAs ([a1] & """"& ActiveWindow.Caption)" & vbCrLf & _
   
10.           "wb.SaveAs s1" & vbCrLf & _
    
11.           "End Sub"
    
12.     Dim WK As Workbook
    
13.     Application.DisplayAlerts = False
    
14.     With Application.FileDialog(msoFileDialogFilePicker)
    
15.         .AllowMultiSelect = False
    
16.         .Show
    
17.         If .SelectedItems.Count = 0 Then Exit Sub '未选择文件
    
18.         Set WK = Application.Workbooks.Open(.SelectedItems(1))
    
19.     End With
    
20.     WK.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString (str)
    
21.     With WK.Sheets(1).Buttons.Add(500, 10, 30, 18)
    
22.         .OnAction = "备份"
    
23.         .Characters.Text = "备份"
    
24.     End With
    
25.     WK.Close True
    
26.     Application.DisplayAlerts = True
    
27. End Sub

复制代码

ztccsj

suye1010 发表于 2012-8-9 22:14

太牛了，就差一点点了
请帮我再确认下原因并修改下

suye1010

如果你想深入学习关于如何用VBA代码来操作VBA Project,可以参考这篇文章

http://wenku.baidu.com/view/e672407b27284b73f2425064.html

ztccsj

suye1010 发表于 2012-8-10 11:34
如果你想深入学习关于如何用VBA代码来操作VBA Project,可以参考这篇文章

http://wenku.baidu.com/view/e ...

• 感谢你，如果我把代码不放入“模块”中，而是直接放入thisworkbook中，是否只修改下面一句即可？
  WK.VBProject.VBComponents.Add(1).CodeModule.AddFromString (str)
  该怎么修改呢？
• add(1)中的1能解释一下吗？
  

suye1010

对的，修改为WK.vbproject.vbcomponents("Thisworkbook").Codemodule.addfromstring(Str)

Add(1)就是插入一个标准的模块

weishikey

高手过招，我们只有旁观的份{:101:}