[已解决]有EXCEL中勾选这一项设置，用VBA代码实现。请朋友们帮帮忙，谢谢大家了！

yjwdjfqb

有EXCEL中勾选这一项设置，用VBA代码实现。请朋友们帮帮忙，谢谢大家了！

最佳答案

月排行榜 / 总排行榜

zjdh

2014-2-23 15:44

这是从大师那儿抄来的：
Sub TrustVBA()
    Dim Key1 As String, Key2 As String, Key3 As String, Key4 As String
    Dim KeyValue1, KeyValue2
    Dim Version As String
    On Error Resume Next
    Version = Application.Version
    Key1 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Version & "\Excel\Security\AccessVBOM"
    Key2 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Version & "\Excel\Security\Level"
    Key3 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & Version & "\Excel\Security\AccessVBOM"
    Key4 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & Version & "\Excel\Security\Level"
    'AccessVBOM 允许访问VBA对象
   Call WriteReg(Key1, 1, "REG_DWORD")
    Call WriteReg(Key2, 1, "REG_DWORD")
    Call WriteReg(Key3, 1, "REG_DWORD")
    Call WriteReg(Key4, 1, "REG_DWORD")
End Sub

Sub WriteReg(strkey As String, Value As Variant, ValueType As String)
    Dim Wshell As Object
    Set Wshell = CreateObject("WScript.Shell")
    If ValueType = "" Then
        Wshell.RegWrite strkey, Value
    Else
        Wshell.RegWrite strkey, Value, ValueType
    End If
    Set Wshell = Nothing
End Sub

跳转到最佳答案楼层

zjdh

这是从大师那儿抄来的：
Sub TrustVBA()
    Dim Key1 As String, Key2 As String, Key3 As String, Key4 As String
    Dim KeyValue1, KeyValue2
    Dim Version As String
    On Error Resume Next
    Version = Application.Version
    Key1 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Version & "\Excel\Security\AccessVBOM"
    Key2 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Version & "\Excel\Security\Level"
    Key3 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & Version & "\Excel\Security\AccessVBOM"
    Key4 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & Version & "\Excel\Security\Level"
    'AccessVBOM 允许访问VBA对象
   Call WriteReg(Key1, 1, "REG_DWORD")
    Call WriteReg(Key2, 1, "REG_DWORD")
    Call WriteReg(Key3, 1, "REG_DWORD")
    Call WriteReg(Key4, 1, "REG_DWORD")
End Sub

Sub WriteReg(strkey As String, Value As Variant, ValueType As String)
    Dim Wshell As Object
    Set Wshell = CreateObject("WScript.Shell")
    If ValueType = "" Then
        Wshell.RegWrite strkey, Value
    Else
        Wshell.RegWrite strkey, Value, ValueType
    End If
    Set Wshell = Nothing
End Sub