试了千百种“信任对VBA工程对象模型的访问”打开的方法，没一个成功的-_-||

百度不到去谷歌

试试下面的代码

1. Option Explicit
   
2. '这段代码使用了WINDOWS脚本文件对注册表进行修改，从这一点来看，病毒还是挺可怕的，你不知道他在注册表里面会干些什么。
   
3. '在运行这段代码后，将开启“信任对VBA工程对象模型的访问”，且该选项将变成灰色。
   
4. '在上面代码中:
   
5. '1.“AccessVBOM”项的值为1代表开启，0表示关闭“信任对VBA工程对象模型的访问”
   
6. '2.“Level”项的值1，2，3分别表示宏的安全级别为低、中、高。
   
7. '3.而语句中“HKEY_LOCAL_MACHINE\Software\Microsoft\Office" & VS & "\Excel\Security\AccessVBOM ”和“HKEY_LOCAL_MACHINE\Software\Microsoft\Office" & VS & "\Excel\Security\Level”添加过后会将相关的选项变成灰色，变为不可选。
   
8. '
   
9. Function VbaSecurityUnlock() '信任对VBA工程对象模型的访问
   
10.     Dim Fso, RK1 As String, RK2 As String, RK3 As String, RK4 As String
    
11.     Dim KValue1 As Variant, KValue2 As Variant
    
12.     Dim VS As String
    
13.     On Error Resume Next
    
14.     VS = Application.Version
    
15.     Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
    
16.     RK1 = "HKEY_CURRENT_USER\Software\Microsoft\Office" & VS & "\Excel\Security\AccessVBOM"
    
17.     RK2 = "HKEY_CURRENT_USER\Software\Microsoft\Office" & VS & "\Excel\Security\Level"
    
18.     RK3 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office" & VS & "\Excel\Security\AccessVBOM"
    
19.     RK4 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office" & VS & "\Excel\Security\Level"
    
20.     KValue1 = 1
    
21.     KValue2 = 1
    
22.     Call WReg(RK1, KValue1, "REG_DWORD")
    
23.     Call WReg(RK2, KValue2, "REG_DWORD")
    
24.     Call WReg(RK3, KValue1, "REG_DWORD")
    
25.     Call WReg(RK4, KValue2, "REG_DWORD")
    
26. End Function
    
27. '--------------------------------------------------------------------------------------------------------------------------------------------
    
28. Sub WReg(strkey As String, Value As Variant, ValueType As String) '写入注册表
    
29.     Dim oWshell
    
30.     Set oWshell = CreateObject("WScript.Shell")
    
31.     If ValueType = "" Then
    
32.         oWshell.REGWRITE strkey, Value
    
33.     Else
    
34.         oWshell.REGWRITE strkey, Value, ValueType
    
35.     End If
    
36.     Set oWshell = Nothing
    
37. End Sub
    
38. '解决变灰的问题，可以手动删除代码中涉及的键值或者运行代码：
    
39. Sub VbaSecurityRepair()
    
40.     On Error Resume Next
    
41.     With CreateObject("WSCRIPT.SHELL")
    
42.         .REGDELETE "HKLM\Software\Microsoft\Office" & Application.Version & "\Excel\Security"
    
43.         .REGWRITE "HKCU\Software\Microsoft\Office" & Application.Version & "\Excel\Security\AccessVBOM", 0, "REG_DWORD"
    
44.         .REGWRITE "HKCU\Software\Microsoft\Office" & Application.Version & "\Excel\Security\Level", 3, "REG_DWORD"
    
45.     End With
    
46. End Sub
    

复制代码

furao_1011

百度不到去谷歌 发表于 2015-8-21 14:06
试试下面的代码

谢谢大神，已经解决了。
这段代码很早就看过了，就是没按照这个实验，这个是可以的。
但是觉得走了点弯路，就没试。
谢谢了

sunny_8848

furao_1011 发表于 2015-8-21 17:17
谢谢大神，已经解决了。
这段代码很早就看过了，就是没按照这个实验，这个是可以的。
但是觉得走了点弯 ...

看了后有点不敢试，能否说下代码怎么在打开文件时自动运行，是放在thisworkbook里面吗

furao_1011

sunny_8848 发表于 2015-8-21 19:30
看了后有点不敢试，能否说下代码怎么在打开文件时自动运行，是放在thisworkbook里面吗

把VbaSecurityUnlock的内容可以放到auto_open里，或者单步执行也行。如果没用应用方面的需要建议就别试了。

sunny_8848

谢谢解答，我还是不尝试了。我是看到Function，好像是函数，然后是函数调用Sub WReg，不知道怎么使用

oglm

furao_1011 发表于 2015-8-22 15:58
把VbaSecurityUnlock的内容可以放到auto_open里，或者单步执行也行。如果没用应用方面的需要建议就别试了 ...

furao_1011，能回复一下你解决问题的方法不？

傅华

我试出一种方法特分享出代码给大家：

Private Sub Workbook_Open() '信任对VBA工程对象模型的访问
Dim oWshell
    Set oWshell = CreateObject("WScript.Shell")
oWshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Excel\Security\AccessVBOM", 1, "REG_DWORD"  '信任对 VBA 项目的访问
With Application
            .SendKeys "~"
            .CommandBars.FindControl(ID:=3627).Execute
            
End With
End Sub  

傅华

我在论坛上和百度上搜索了很多设置的方法，都没得到效果，经过我无数次测试之后，揉合了以下两段代码，测试有效，分享给大家：
Private Sub Workbook_Open() '信任对VBA工程对象模型的访问
Dim oWshell
    Set oWshell = CreateObject("WScript.Shell")
oWshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Excel\Security\AccessVBOM", 1, "REG_DWORD"  '信任对 VBA 项目的访问
With Application
            .SendKeys "~"
            .CommandBars.FindControl(ID:=3627).Execute
            
End With
End Sub  

powerZZ

问题解决了吗？有什么好的方法，我的也是灰色选不中

踏歌123

傅华 发表于 2017-12-29 21:10
我试出一种方法特分享出代码给大家：

Private Sub Workbook_Open() '信任对VBA工程对象模型的访问

这个可用