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

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:}

ztccsj

suye1010 发表于 2012-8-10 22:08
对的，修改为WK.vbproject.vbcomponents("Thisworkbook").Codemodule.addfromstring(Str)

Add(1)就是插入 ...

版主，验证了下，
修改该行为WK.vbproject.vbcomponents("Thisworkbook").Codemodule.addfromstring(Str)后

运行到该行后提示如下错误：
运行时错误'13'
类型不匹配

打扰了，请再看下是否不能这样写？

suye1010

ztccsj 发表于 2012-8-11 08:35
版主，验证了下，
修改该行为WK.vbproject.vbcomponents("Thisworkbook").Codemodule.addfromstring(Str ...

在我这里运行完全正常。如果你还是有这样的问题。建议把包含代码的出错文件以附件形式上传供大家判断。

ztccsj

suye1010 发表于 2012-8-11 10:52
在我这里运行完全正常。如果你还是有这样的问题。建议把包含代码的出错文件以附件形式上传供大家判断。

谢谢你，我又试了一次，可能是试验过程中某个字符错误导致的吧，现在确实能运行了。非常感谢。

如果您还能有时间，再帮解答以下问题：
通过add(1)，会增加无数个新模块，比如第一次运行后，在“新文件”中增加了一个模块1，模块1中被拷贝了“备份代码”
再次运行该程序，又会产生一个新的模块2，且重复被拷贝进同样的“备份代码”

此事，打开“新文件”，点击“备份按钮”因为在模块中出现了重名的"sub 备份（）"，此时就报错了。
怎么才能做到以下：
   先检测目标文件（新文件的代码中是否已存在要拷贝的代码或者函数名（备份（）），如果已经存在，那么就提示信息或者直接退出。如果不存在，那么执行拷贝。

（我现在的水平处于能简单看懂代码且简单修改应用阶段，因基础知识欠缺，经验也不足，写全新的代码很有难度,感谢你赐教）

suye1010

1. Sub AddBackupToFile()
   
2.     Dim str As String, VbComp
   
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.     For Each VbComp In WK.VBProject.VBComponents
    
21.        If VbComp.CodeModule.Find("Sub 备份()", 1, 1, -1, -1) Then
    
22.             MsgBox "目标文件中已存在备份程序,程序将退出", vbInformation + vbOKOnly, "温馨提示"
    
23.             GoTo 100
    
24.        End If
    
25.     Next
    
26.     WK.VBProject.VBComponents("ThisWorkbook").AddFromString (str)
    
27.     With WK.Sheets(1).Buttons.Add(500, 10, 30, 18)
    
28.         .OnAction = "备份"
    
29.         .Characters.Text = "备份"
    
30.     End With
    
31. 100:
    
32.     WK.Close True
    
33.     Application.DisplayAlerts = True
    
34. End Sub

复制代码

ztccsj

谢谢您                      ，下面这个附件是误操作。    我删除不了，不要下载         

ztccsj

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

谢谢你，实现以上功能后，如何把一部分代码再用程序去掉呢？

比如：我把两段代码，一部分放入模块中，一部分放入thisworkbook中，现在我想通过按钮再去掉str1相应的代码，该怎怎么写程序去除呢？   
WK.VBProject.VBComponents.Add(1).CodeModule.AddFromString (str)
WK.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString (str1)