VBA/Excel/Access/Word/Excel/Workbook Event — различия между версиями

Материал из VB Эксперт
Перейти к: навигация, поиск
м (1 версия)
 
(нет различий)

Версия 16:33, 26 мая 2010

Activate and deactivate events in a workbook

 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    MsgBox Sh.Name
End Sub



BeforeClose event is used to delete a custom menu

 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim cbWSMenuBar As CommandBar
    On Error Resume Next
    Set cbWSMenuBar = Application.rumandBars("Worksheet menu bar")
    cbWSMenuBar.Controls("MrExcel Programs").Delete
End Sub



Before Save event

 
Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
      Dim lReply As Long
      If SaveAsUI = True Then
      lReply = MsgBox("Do you wish to save this workbook?", vbQuestion + vbOKCancel)
      Cancel = (lReply = vbCancel)
      If Cancel = False Then Me.Save
          Cancel = True
      End If
End Sub



Cancel Close action based on the A1 value

 
     Sub Workbook_BeforeClose(Cancel As Boolean)
         If ThisWorkbook.Sheets("Sheet1").Range("A1").Value <> True Then
            Cancel = True
         End If
     End Sub



create your own Save dialog in the event:

 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Msg As String
    Dim Response
    Dim cbWSMenuBar As CommandBar
    If Not ThisWorkbook.Saved Then
        Msg = "Do you want to save the changes you made to " & Me.Name & "?"
        Response = MsgBox(Msg, vbQuestion + vbYesNoCancel)
        Select Case Response
            Case vbYes
                ThisWorkbook.Save
            Case vbNo
                ThisWorkbook.Saved = True
            Case vbCancel
                Cancel = True
                Exit Sub
            End Select
    End If
    On Error Resume Next
    Set cbWSMenuBar = Application.rumandBars("Worksheet menu bar")
    cbWSMenuBar.Controls("MrExcel Programs").Delete
End Sub



If you want Excel to stop prompting you to save changes you didn"t make

 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
         Me.Saved = True
End Sub



If you want to make sure that all changes are saved when the workbook closes

 
     Private Sub Workbook_BeforeClose(Cancel As Boolean)
           If Not ThisWorkbook.Saved Then
           ThisWorkbook.Save
           End If
     End Sub



If you want to prevent users from printing only particular sheets in your workbook, use this similar code instead:

 
Sub workbook_BeforePrint(Cancel As Boolean)
   Select Case ActiveSheet.Name
          Case "Sheet1", "Sheet2"
          Cancel = True
          MsgBox "Sorry, you cannot print this sheet from this workbook", vbInformation
   End Select
End Sub



minimizes the workbook"s window:

 
Private Sub Workbook_Deactivate()
    ThisWorkbook.Windows(1).WindowState = xlMinimized
End Sub



only allow the workbook to close if the figure in A1 is between 500 and 600:

 
     Private Sub Workbook_BeforeClose(Cancel As Boolean)
           Dim dProfit As Double
           dProfit = ThisWorkbook.Worksheets(1).Range("A1").Value
           If dProfit < 500 Or dProfit > 600 Then
           MsgBox "Profit must be in the range 500 to 600"
           Cancel = True
           End If
     End Sub



Pass value between events

 
Dim OldSheet As Object
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Set OldSheet = Sh
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If TypeName(Sh) = "Chart" Then
        MsgBox "Sorry, you can"t activate any charts."
        OldSheet.Activate
    End If
End Sub



Preventing Users from Inserting More Worksheets

 
Private Sub Workbook_NewSheet(ByVal Sh As Object)
      Application.DisplayAlerts = False
      MsgBox "Sorry, you cannot add any more sheets to this workbook", _
      vbInformation
      Sh.Delete
      Application.DisplayAlerts = True
End Sub



procedure is executed when the workbook is closed

 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Open Application.Path & "\test.txt" _
      For Append As #1
    Print #1, "Stopped " & Now
    Close #1
End Sub



Set application key in Workbook Open event and BeforeCloseEvent

 
Private Sub Workbook_Open()
    Application.OnKey "{RIGHT}", "HighlightRight"
    Application.OnKey "{LEFT}", "HighlightLeft"
    Application.OnKey "{UP}", "HighlightUp"
    Application.OnKey "{DOWN}", "HighlightDown"
    Application.OnKey "{DEL}", "DisableDelete"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "{RIGHT}"
    Application.OnKey "{LEFT}"
    Application.OnKey "{UP}"
    Application.OnKey "{DOWN}"
    Application.OnKey "{DEL}"
End Sub



The BeforeClose event for a workbook

 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Msg As String
    Dim Ans As Integer
    Dim FName As String
    Msg = "Would you like to make a backup of this file?"
    Ans = MsgBox(Msg, vbYesNo)
    If Ans = vbYes Then
        FName = "F:\BACKUP\" & ThisWorkbook.Name
        ThisWorkbook.SaveCopyAs FName
    End If
End Sub



The BeforeSave event for a workbook

 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     If SaveAsUI Then
         MsgBox "You cannot save a copy of this workbook!"
         Cancel = True
    End If
End Sub



to discard any changes to the workbook

 
     Private Sub Workbook_BeforeClose(Cancel As Boolean)
           ThisWorkbook.Saved = True
     End Sub



To link that tab"s command bar to a right-click in any cell, enter the following code in the private module of ThisWorkbook:

 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
      Dim cCont As CommandBarButton
      On Error Resume Next
      Application.rumandBars("Cell").Controls("Sheet Index").Delete
      On Error GoTo 0
      Set cCont = Application.rumandBars("Cell").Controls.Add _
      (Type:=msoControlButton, Temporary:=True)
      With cCont
        .Caption = "Sheet Index"
        .OnAction = "IndexCode"
      End With
End Sub



use the BeforePrint event to add information to a header or footer before the sheet is printed

 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    ActiveSheet.PageSetup.RightFooter = ActiveWorkbook.FullName
End Sub



Workbook activation events

 
Private Sub Workbook_Activate()
    ActiveWindow.WindowState = xlMaximized
End Sub



Workbook_BeforePrint

 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Debug.Print Now()
    Debug.Print Application.UserName
    Debug.Print ActiveSheet.Name
End Sub



Workbook Events Open: enable custom toolbar

 
Private Sub Workbook_Open()
    Application.rumandBars("My Custom Toolbar").Enabled = True
End Sub



Workbook open event

 
Private Sub Workbook_Open()
  Dim w As Window
  MsgBox "Executing the event procedure Workbook_Open."
  For Each w In Windows
    If w.Parent.Name <> ActiveWorkbook.Name And w.Visible Then
      w.WindowState = xlMinimized
    End If
  Next
End Sub



Workbook_SheetSelectionChange

 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 
        If Target.Row Mod 2 = 0 Then 
            MsgBox "You selected the range " & Target.Address & " on " & Sh.Name, vbOKOnly, _ 
                   "SheetSelectionChange Event" 
        Else 
            MsgBox "You selected the range " & Target.Address & " on " & Sh.Name, vbOKOnly, _ 
                   "SheetSelectionChange Event" 
        End If 
End Sub