VBA/Excel/Access/Word/Excel/Workbook Event

Activate and deactivate events in a workbook

   <source lang="vb">

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

   MsgBox Sh.Name

End Sub

</source>
   
  

BeforeClose event is used to delete a custom menu

   <source lang="vb">

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

</source>
   
  

Before Save event

   <source lang="vb">

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

</source>
   
  

Cancel Close action based on the A1 value

   <source lang="vb">

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

create your own Save dialog in the event:

   <source lang="vb">

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

</source>
   
  

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

   <source lang="vb">

Private Sub Workbook_BeforeClose(Cancel As Boolean)

        Me.Saved = True

End Sub

</source>
   
  

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

   <source lang="vb">

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

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

   <source lang="vb">

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

</source>
   
  

minimizes the workbook"s window:

   <source lang="vb">

Private Sub Workbook_Deactivate()

   ThisWorkbook.Windows(1).WindowState = xlMinimized

End Sub

</source>
   
  

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

   <source lang="vb">

    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
</source>
   
  

Pass value between events

   <source lang="vb">

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

</source>
   
  

Preventing Users from Inserting More Worksheets

   <source lang="vb">

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

</source>
   
  

procedure is executed when the workbook is closed

   <source lang="vb">

Private Sub Workbook_BeforeClose(Cancel As Boolean)

   Open Application.Path & "\test.txt" _
     For Append As #1
   Print #1, "Stopped " & Now
   Close #1

End Sub

</source>
   
  

Set application key in Workbook Open event and BeforeCloseEvent

   <source lang="vb">

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

</source>
   
  

The BeforeClose event for a workbook

   <source lang="vb">

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

</source>
   
  

The BeforeSave event for a workbook

   <source lang="vb">

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

</source>
   
  

to discard any changes to the workbook

   <source lang="vb">

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
          ThisWorkbook.Saved = True
    End Sub
</source>
   
  

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

   <source lang="vb">

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

</source>
   
  

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

   <source lang="vb">

Private Sub Workbook_BeforePrint(Cancel As Boolean)

   ActiveSheet.PageSetup.RightFooter = ActiveWorkbook.FullName

End Sub

</source>
   
  

Workbook activation events

   <source lang="vb">

Private Sub Workbook_Activate()

   ActiveWindow.WindowState = xlMaximized

End Sub

</source>
   
  

Workbook_BeforePrint

   <source lang="vb">

Private Sub Workbook_BeforePrint(Cancel As Boolean)

   Debug.Print Now()
   Debug.Print Application.UserName
   Debug.Print ActiveSheet.Name

End Sub

</source>
   
  

Workbook Events Open: enable custom toolbar

   <source lang="vb">

Private Sub Workbook_Open()

   Application.rumandBars("My Custom Toolbar").Enabled = True

End Sub

</source>
   
  

Workbook open event

   <source lang="vb">

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

</source>
   
  

Workbook_SheetSelectionChange

   <source lang="vb">

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

</source>