用vba写入另一个工作薄一段代码，使其不能另存为。

cccji

困惑我很久的问题，哪位老师给解决一下，不胜感激！有book1和book2，在book1写一段代码，运行代码后，可以在book2写入代码，使其禁止另存为。

huang1314wei

1. Sub text()
   
2.     Dim wb As Workbook
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set wb = Workbooks.Open(ThisWorkbook.Path & "" & "book2.xlsx")
   
6.     With wb.VBProject.VBComponents("ThisWorkbook")
   
7.         .CodeModule.DeleteLines 1, .CodeModule.CountOfLines  '删除原代码
   
8.         .CodeModule.InsertLines 1, "Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)"
   
9.         .CodeModule.InsertLines 2, "    Dim s As Long"
   
10.         .CodeModule.InsertLines 3, "    If SaveAsUI = True Then"
    
11.         .CodeModule.InsertLines 4, "      s = MsgBox(""该工作簿不允许用“另存为”来保存，"" & ""你要用原工作簿名称来保存吗？ "", vbQuestion + vbOKCancel)"
    
12.         .CodeModule.InsertLines 5, "      Cancel = (response = vbCancel)"
    
13.         .CodeModule.InsertLines 6, "    If Cancel = False Then Me.Save"
    
14.         .CodeModule.InsertLines 7, "    Cancel = True"
    
15.         .CodeModule.InsertLines 8, "    End If"
    
16.         .CodeModule.InsertLines 9, "End Sub"
    
17.    End With
    
18.    wb.SaveAs Filename:=ThisWorkbook.Path & "\book2", FileFormat:=52
    
19.    wb.Close True
    
20.    Kill ThisWorkbook.Path & "" & "book2.xlsx"
    
21.    Application.ScreenUpdating = True
    
22.    Application.DisplayAlerts = True
    
23. End Sub

复制代码

huang1314wei

写这样的代码最没有意思的，楼主附件都不给，我还要给你做个附件，醉了如果提示错误，需要勾选信任对VBA工程对象模型的访问

向另一个工作簿注入代码.rar (19.32 KB, 下载次数: 88)

2015-10-18 07:24 上传

点击文件名下载附件

cccji

非常感谢huang1314wei老师！你真是太棒了！如果再进一步，book2有工程密码：123，写入代码再用原密码锁定book2的工程，还需要怎样修改代码？

maditate

有点过份了，破别人的密码，再塞进私货，然后再上锁。有点犯罪的感觉。

cccji

呵呵，是自己的，没有破解，自己知道自己密码，我是用book1生成试题，另存为book2，book2是让别人在电脑上做的试题，但又不想让book2另存为文本格式的，因为这样就泄露了隐藏的答案。所以。。{:soso_e183:}  但是book2是有工程密码的。

花开1

huang1314wei 发表于 2015-10-18 07:25
写这样的代码最没有意思的，楼主附件都不给，我还要给你做个附件，醉了如果提示错误，需要勾选信任对VBA工 ...

前辈您好。看到您刚解决的问题和我遇到的问题差不多，都是从一个工作簿对另一个工作薄操作，看了代码并测试，还是不对。能否劳烦您帮我看看？谢谢您！

163a

huang1314wei 发表于 2015-10-18 07:22

你好，能不能帮我实现我的需求？
我的帖子里面有相关要求，我想实现动态查找数据，就是根据我每次输入的字作为关键字来查找

huang1314wei

花开1 发表于 2015-10-19 20:17
前辈您好。看到您刚解决的问题和我遇到的问题差不多，都是从一个工作簿对另一个工作薄操作，看了代码并测 ...

你需要上传完整附件并附代码，附件当中我并没有看到TextBox2控件

LMY123

向另一个工作簿注入代码