Programatically bringing up Excel's “Trust Center Settings” dialog

梦想的初衷 提交于 2020-07-15 07:39:00

问题


I need users to click the "Trust access to the VBA project object model" so that an app I'm building can help them import code to the VBE.

I could display a messagebox or provide documentation telling them how to change setting (and warning about repercussions if they do). But that setting is still buried 5 clicks down in the Excel UI...in fact even I have trouble remembering where to find it.

So what I'd like to do is programmatically open that window for them.

I could probably use the notoriously fickle SendKeys method, but I wonder if there is a better way...

(I see that you can actually set access to the VBA project object model for users via a macro by using a VBS script to change the key's value when the target Office application is not running them as per this MSDN article but I would much prefer that the user manually enables this option or elects not to).

Edit: VBA or VSTO solutions are fine, or anything else you can think of.


回答1:


This will bring up the dialog.

Application.CommandBars.ExecuteMso("MacroSecurity")

Alternatively, this does the same thing:

Application.CommandBars.FindControl(Id:=3627).Execute

The user will need to check the box, it cannot be checked programmatically even using SendKeys.

Extra Credit: Is it possible to change the registry key?

There is also a registry key which you may be able to change using VBA.

enter image description here

I thought you might be able to use a subroutine like this to set the registry key to "allow access". However, as I tested this and it does change the registry key value, it doesn't seem to have any effect on my ability to access the VBOM:

  • If my settings do not allow access, and I change the key value to 1, then I get a 1004 error.
  • If my settings do allow access, and I change the key value to 0, sample code that manipulates the VBOM still works.
  • If I change the registry key programmatically, it reverts to its previous state when re-starting the Excel Application.

It's possible I did something wrong, so I will leave this here on the off-chance that someone else can get it to work. I have used this sort of function to set custom registry keys for my own applications, i.e., to store the application's current version #, etc. but perhaps this part of the registry is simply locked down and can't be manipulated this way.

Const regKey As String = "HKEY_CURRENT_USER\SOFTWARE\MICROSOFT\OFFICE\14.0\Excel\Security\AccessVBOM"
Sub AllowAccessToVBOM()
        With CreateObject("WScript.Shell")
            'write registry key
            .RegWrite regKey, "0", "REG_DWORD"
            MsgBox regKey & " : " & .regRead(regKey)
        End With


End Sub



回答2:


i was working on this and actually you CAN make it work with SendKeys and DoEvents. My following code works with 16.0 Spanish Version of Excel. Just define this with Ctrl + "m" and will run ok.

Option Explicit
#If VBA7 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub VBATrust()
Dim x As Boolean, y As Boolean
Dim inicio, final

Application.OnKey "+{m}"

inicio = Now()
x = VBAIsTrusted

'If Application.LanguageSettings.LanguageID(msoLanguageIDUI) = 3082 _
'And Application.Version = "16.0" Then

    AppActivate (ThisWorkbook.Name & " - Excel")
    Application.Wait (Now() + TimeValue("00:00:03"))
    Application.SendKeys "%ao{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}%c", True
    Application.SendKeys "{UP}{UP}{UP}{UP}{UP}{UP}{UP}{UP}{UP}{UP}{UP}", True
    Application.SendKeys "{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}", True
    Application.SendKeys "{TAB}{TAB} ", True
    Application.SendKeys "~", True
    Application.SendKeys "{TAB}~", True

'End If

DoEvents
y = VBAIsTrusted
final = Now()

MsgBox inicio & " - Modelo de objetos VBA : " & x & vbNewLine & _
       final & " - Modelo de objetos VBA : " & y

End Sub

Public Function VBAIsTrusted() As Boolean
Dim a1 As Integer
On Error GoTo Label1
a1 = ActiveWorkbook.VBProject.VBComponents.Count
VBAIsTrusted = True
Exit Function
Label1:
VBAIsTrusted = False
End Function


来源:https://stackoverflow.com/questions/25234422/programatically-bringing-up-excels-trust-center-settings-dialog

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!