如何在Workbook_beforeclose中 取消 信任对VBA工程对象模型的访问？

liucqa

Function SecuritySet(WBk As Workbook) As Boolean
    On Error Resume Next

    Dim objVbaProj As Object
    Set objVbaProj = WBk.VBProject
    If CDbl(Val(Application.Version))=12 Then
        SecuritySet = Not CBool(err.Number)
    Else
        MsgBox "本程序只支持Excel2007版本"
    End If
End Function

Private Sub Workbook_beforeclose(cancel As Boolean)
'取消“信任对VBA工程对象模型的访问”
    If SecuritySet(ThisWorkbook) Then
        MsgBox "本程序将取消 信任对VBA工程对象模型的访问 ,请重新退出一次"
        Application.SendKeys "%tmst{tab}{tab}v~", True
        cancel = True
    End If
    Exit Sub
End Sub

目前我只有上面的办法，两次退出才能取消信任对VBA工程对象模型的访问。

如果去掉cancel语句的话，Excel直接关闭，但sendkeys的操作未能生效。谁知道如何一次完成？

请在Excel2007下测试

liucqa

Private Sub Workbook_Open()
    '打开“信任对VBA工程对象模型的访问”
    If Not SecuritySet(ThisWorkbook) Then MsgBox "本程序将打开“信任对VBA工程对象模型的访问”"
    Do Until SecuritySet(ThisWorkbook)
        With Application
            If CDbl(Val(Application.Version)) <= 11 Then
                MsgBox "本程序只支持Excel2007以上版本"
                End
            Else
                .SendKeys "%tmst{tab}{tab}v~"
            End If
            .CommandBars.FindControl(ID:=3627).Execute
        End With
    Loop
End Sub


Private Sub Workbook_beforeclose(cancel As Boolean)
'取消“信任对VBA工程对象模型的访问”
    If SecuritySet(ThisWorkbook) Then
        MsgBox "本程序将取消“信任对VBA工程对象模型的访问”,请重新退出一次"
        Application.SendKeys "%tmst{tab}{tab}v~", True
        'Application.CommandBars.FindControl(ID:=3627).Execute
        cancel = True
    End If
End Sub


谁知道如何在Workbook_beforeclose一次完成取消对VBA工程的访问？

noddry

同问，我也遇到同样问题

liucqa

还得自己解决，顺便谢谢论坛上的http://club.excelhome.net/forum.php?mod=viewthread&tid=743719

Private Sub Workbook_beforeclose(cancel As Boolean)
'取消“信任对VBA工程对象模型的访问”
    If SecuritySet(ThisWorkbook) Then
        Application.OnTime earliesttime:=Now + TimeSerial(0, 0, 1), procedure:="quitapp", schedule:=True
        Application.SendKeys "%tmst{tab}{tab}v~", True
        cancel = True
    End If
    Exit Sub
End Sub
在标准模块写如下代码
Private Declare Function PostMessage _
    Lib "user32.dll" _
    Alias "PostMessageA" ( _
        ByVal hWnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         ByVal lParam As Long) _
As Long
Private Const WM_CLOSE = &H10

Sub quitapp()
Call PostMessage(Application.hWnd, WM_CLOSE, 0, 0)
End Sub

goldowl2011

Thanks a lot. Good codes.

shbc001

学习一下,请问2003的怎么设置呢???

lskvslgt

留个脚印，想楼主致敬。