[求助]如何通过一个工作簿的VBA对新生成的工作簿添加VBA代码？

WNRLXF

有这么一个问题：
我有一个VBA程序加载宏，通过这个加载宏新打开一个工作簿，当我要保存这个新打开的工作簿时，如何触发这个新打开的工作簿自行用VBA程序检查。也就是说，当新打开一个工作簿后，VBA程序加载宏就向这个新打开的工作簿的Thisworkbook加入指定的VBA代码。当这个新打开的工作簿要保存时，原VBA程序加载宏写入到这个新打开的工作簿的代码就执行任务。可否这样？请高手指点，比较急。

maditate

QUOTE:

以下是引用WNRLXF在2007-10-10 15:49:15的发言：
有这么一个问题：
我有一个VBA程序加载宏，通过这个加载宏新打开一个工作簿，当我要保存这个新打开的工作簿时，如何触发这个新打开的工作簿自行用VBA程序检查。也就是说，当新打开一个工作簿后，VBA程序加载宏就向这个新打开的工作簿的Thisworkbook加入指定的VBA代码。当这个新打开的工作簿要保存时，原VBA程序加载宏写入到这个新打开的工作簿的代码就执行任务。可否这样？请高手指点，比较急。

好呀，我也想学会，这样可以造病毒了，危害百姓。

phenix_love

这个如果循环起来的话，那不是很恐怖！

WNRLXF

QUOTE:

以下是引用maditate在2007-10-10 17:27:36的发言：

好呀，我也想学会，这样可以造病毒了，危害百姓。

呵呵，我可没往这方面想，只想做有益的事情，没想着做危害百姓的事。

hiyou

首先,你的EXCEL必须手工打开VBPROJECT的信任选项（这个不能用代码打开,为了安全性考虑，也就是所谓病毒之类的问题，由用户打开，就是用户自已已经确定了“我知道有这么回事”）

选工具-宏-安全性，然后选择“信任对于VISUAL BASIC项目的访问”（默认是未选定的，你要确定）

有了上面的选项，就可以“用代码生成代码”，事实上是用代码控制EXCEL的VBA PROJECT对象

set x=workbooks("工作簿名").VBProject.VBComponents("thisworkbook")
x.CodeModule.AddFromString "dim a as string"

上面第一句，X是取得对应工作簿的那个模块，你要thisworkbook，我就这么演示了，不过，有例外的情况，你注意一下，虽然thisworkbook是默认的名字，如果这个名字被改掉，这行代码就找不到对应的模块——当然工作簿本身是第1个模块，你可以改成这样

set x=workbooks("工作簿名").VBProject.VBComponents(1)

但其它的情况，例如取SHEET1、SHEET2，你要自已研究，我不能一一帮你分析

第二行代码是写入，模块对象（VBCOMPONENTS)只能用于导入、导出，如果要写入代码，要取得它对应的CODEMODULE对象才可以

CODEMODULE对象可以用AddFromFile和AddFromString方法添加代码，上面我用了AddFromString加入一行声明

L=某模块.CodeModule.CountOfLines   '这个属性是取得代码总行数

strMYCODE=某模块.CodeModule.Lines(1,L)  '根据总行数，取得本模块所有代码（字符串）

用以上两行，你可以得到指定模块对象的所有代码字符串

最后，让你看一下这个增殖的程序，你可以把它放到某个工作簿的按键上

其中黑体部分注意一下，它只复制第1个工作簿的THISWORKBOOK模块代码，如果你要改进，必须指明名字，比如你的工作簿是EXCELHOME.XLS，自已填上

代码的效果是，每运行一次，生成一个NEW BOOK，NEWBOOK的THISWORKBOOK上会有同样的代码

但不要认为这是病毒...当然你一定要这么想也没办法。在技术安全性上，这与病毒区别很大，安全性、应用和代码复制的实用性，本身的平衡是要考量的，为什么在OFFICE97以后要进行宏的运行限制，为什么要进行数字签名，这比起“代码控制下复制代码”，安全性是更重要的

Sub addcode()
Set x = Workbooks(1).VBProject.VBComponents(1)
L = x.CodeModule.CountOfLines
strmycode = x.CodeModule.Lines(1, L)
Set x = Workbooks.Add.VBProject.VBComponents(1)
Set myCM = x.CodeModule
myCM.AddFromString strmycode
End Sub

hiyou

又发了一次，重复了....多余的编辑掉，留下新加的一点点注释

Sub addcode()
'Set x = Workbooks(1).VBProject.VBComponents(1)
Set x = ActiveWorkbook.VBProject.VBComponents(1)
L = x.CodeModule.CountOfLines
strmycode = x.CodeModule.Lines(1, L)

Set x = Workbooks.Add.VBProject.VBComponents(1)
Set myCM = x.CodeModule
myCM.AddFromString strmycode

End Sub

注意黑体的两行，VBCOMPONENTS(1)是取第一个模块，也就是THISWORKBOOK模块，一般可以这样取：

set x = Workbooks(某工作簿).VBProject.VBComponents("Thisworkbook")

比如你要取MODULE1，USERFORM1，SHEETX，都是这样，大部分的THISWORKBOOK也是名为THISWORKBOOK（新生成的NEW BOOK也是THISWORKBOOK），不过有少数的WORKBOOK中，THISWORK会被改名，这时就取不到了

另外，ActiveWorkbook是当前工作簿，想定位一个工作簿，可以用Workbooks(工作簿名)或用索引的形式，这是常识

[此贴子已经被作者于2007-10-11 13:23:36编辑过]

WNRLXF

QUOTE:

以下是引用hiyou在2007-10-11 13:19:58的发言：

又发了一次，重复了....多余的编辑掉，留下新加的一点点注释

QUOTE:

Sub addcode()
'Set x = Workbooks(1).VBProject.VBComponents(1)
Set x = ActiveWorkbook.VBProject.VBComponents(1)
L = x.CodeModule.CountOfLines
strmycode = x.CodeModule.Lines(1, L)

Set x = Workbooks.Add.VBProject.VBComponents(1)
Set myCM = x.CodeModule
myCM.AddFromString strmycode

End Sub

注意黑体的两行，VBCOMPONENTS(1)是取第一个模块，也就是THISWORKBOOK模块，一般可以这样取：

set x = Workbooks(某工作簿).VBProject.VBComponents("Thisworkbook")

比如你要取MODULE1，USERFORM1，SHEETX，都是这样，大部分的THISWORKBOOK也是名为THISWORKBOOK（新生成的NEW BOOK也是THISWORKBOOK），不过有少数的WORKBOOK中，THISWORK会被改名，这时就取不到了

另外，ActiveWorkbook是当前工作簿，想定位一个工作簿，可以用Workbooks(工作簿名)或用索引的形式，这是常识

谢谢hiyou的详细解释，实在感谢。

WNRLXF

还有一个问题，不好意思呀。
我写了这一段代码（目的是要对新生成的工作簿中生成一个“test"的过程）
Sub do_work()
Workbooks.Add
Set x = ActiveWorkbook.VBProject.VBComponents(1)

x.CodeModule.AddFromString "sub test()"
x.CodeModule.AddFromString "dim a as string"
x.CodeModule.AddFromString "a=8000"
x.CodeModule.AddFromString "mxgbox a "
x.CodeModule.AddFromString "end sub "
End Sub

但执行起来的效果变成如下：

Dim a As String
a = 8000
mxgbox a
End Sub
Sub test()

请问要如何修改上面的代码才能保证新生成的过程“test”放在第一行呢？还请hiyou再帮忙一下，真不好意思呀。

[此贴子已经被作者于2007-10-12 10:35:12编辑过]

hiyou

AddFromString并不确定插入的位置,它只认定一个字符串,在插入"dim a as string"这个声明时,它自作主张把插入行定位到开始部分,其它的又重新开始

解决的办法之一,是把整个SUB先做成一个字符串,一口气写入:

Sub do_work2()
Workbooks.Add
Set x = ActiveWorkbook.VBProject.VBComponents(1)
strProc = "sub test()"
strProc = strProc & vbCrLf & "dim a as string"
strProc = strProc & vbCrLf & "a=8000"
strProc = strProc & vbCrLf & "msgbox a "
strProc = strProc & vbCrLf & "end sub "
x.CodeModule.AddFromString strProc
End Sub

这种方法对初学者看上去是有点麻烦(VBCRLF是换行),如果你了解字符串的构成就OK了,也可以做一个专门插入字符串的函数，看上去漂亮一点（比如这样：strProc=AddStr("dim a as string"))

另一种方法是指定行号，用CodeModule.InsertLines方法插入：

下面这个做了一点改进，用的是字符串，但插入行号位置是常数，你可以自已看看

Sub do_work3()
Set mybook = Workbooks.Add

Set x = ActiveWorkbook.VBProject.VBComponents(1)
x.CodeModule.InsertLines 1, "sub test()"
x.CodeModule.InsertLines 2, "dim a as string"
x.CodeModule.InsertLines 3, "strMsg=" & Chr(34) & "hello,this is " & mybook.Name & Chr(34)
x.CodeModule.InsertLines 4, "msgbox strMsg "
x.CodeModule.InsertLines 5, "end sub "
End Sub

你应该注意的是黑体部分，一个空白的模块，第一次插入时，总是在第1行，即使你是用

x.CodeModule.InsertLines 15, "sub test()"

只要是第1次加代码，可能都是在第1行

因此，你也可以先插入SUB TEST和END SUB，再用这样的语句，查出已经存在的SUB过程在哪里：

subline=x.codemodule.procbodyline("test",0)  '后面那个0，你照填吧，不要多问，这是SUB和FUNTION的参数

比如说，如果SUB TEST是在第1行，返回的就是1，你应该从第2行开始插，如果是6，就从7开始插

以上

WNRLXF

非常感谢hiyou的大力帮助，解说问题也非常详尽，让人一听就懂，非常地棒。