如果关注Form1,则取消保存文件

时间:2012-09-25 15:26:34

标签: excel vba

Private Sub Workbook_BeforeSave...  
MsgBox "Why"

如果Form1被聚焦 - 则不会出现MsgBox。保存程序被取消 请不要告诉我最终用户必须在表单外单击以保存文件 Form1不是模态的。

1 个答案:

答案 0 :(得分:2)

  

请在表单上放置一个文本框,将光标放在其中,或者只是   单击表单标题。然后按Ctrl + S,查看是否出现MsgBox   或不。 - Alegro 49分钟前

在这种情况下,只需将此代码粘贴到您的用户表单中即可。此代码稍微修改了我的其他answer

代码(经过测试和测试)

Private Declare Function GetKeyboardState _
Lib "user32" (pbKeyState As Byte) As Long

Private Myarray(255) As Byte

Dim Cntrl_Key As Boolean, Sletter_Key As Boolean

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
    If KeyCode = 17 Then Cntrl_Key = True
    If KeyCode = 83 Then Sletter_Key = True
    Call ShowKey
End Sub

Private Sub RefreshKeyState(RefreshState As Boolean)
   If RefreshState Then
      Call GetKeyboardState(Myarray(0))
   End If
End Sub

Private Sub ShowKey()
    '~~> Check for Ctrl + S
    If Cntrl_Key = True And Sletter_Key = True Then
        '~~> Save Workbook
        ActiveWorkbook.Save
        Cntrl_Key = False
        Sletter_Key = False
    End If
End Sub

<强> SCREENSHOT

enter image description here

注意:这不是一个万无一失的方法,因为用户可能会按 CTRL 然后键入其他内容然后按“S”键然后代码仍会触发。我们可以包括一个小的检查,以查看按下 CTRL 后按下的下一个键是否为 S 。如果没有,那么再次将其设置为假...例如

Private Declare Function GetKeyboardState _
Lib "user32" (pbKeyState As Byte) As Long

Private Myarray(255) As Byte

Dim Cntrl_Key As Boolean, Vletter_Key As Boolean
Dim OtherLetter As Boolean

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
    If KeyCode = 17 Then Cntrl_Key = True
    If KeyCode = 83 Then Vletter_Key = True
    If KeyCode <> 83 And KeyCode <> 17 Then
        OtherLetter = True
    End If
    Call ShowKey
End Sub

Private Sub RefreshKeyState(RefreshState As Boolean)
   If RefreshState Then
      Call GetKeyboardState(Myarray(0))
   End If
End Sub

Private Sub ShowKey()
    '~~> Check for Ctrl + S
    If Cntrl_Key = True And OtherLetter = True Then
        Cntrl_Key = False
    ElseIf Cntrl_Key = True And Vletter_Key = True Then
        '~~> Save Workbook
        ActiveWorkbook.Save
        Cntrl_Key = False
        Vletter_Key = False
    End If
End Sub