Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'Désactive l'évènement
    Application.EnableEvents = False
    'modification dans la cellule A1
    Sheets(1).Range("A1") = Sheets(1).Range("A1") + 1
    'Réactive l'évènement
    Application.EnableEvents = True
End Sub

Private Sub Workbook_AfterXmlExport(ByVal Map As XmlMap, ByVal Url As String, _
    ByVal Result As XlXmlExportResult)

    MsgBox Map.Name & vbCrLf & _
        Url & vbCrLf & _
        Result
End Sub

Private Sub Workbook_AfterXmlImport(ByVal Map As XmlMap, ByVal IsRefresh As Boolean, _
    ByVal Result As XlXmlImportResult)
    
    MsgBox IsRefresh & vbCrLf & _
        Map.Name & vbCrLf & _
        Result
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Vérifie le contenu de la cellule A1 dans la Feuil1
    If Sheets("Feuil1").Range("A1") = "" Then
        MsgBox "Complétez la cellule A1"
        'Empêche la fermeture si la cellule A1 est vide
        Cancel = True
    Else
        'Enregistre les modifications avant la fermeture du classeur
        ThisWorkbook.Save
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
End Sub

Private Sub Workbook_BeforeXmlExport(ByVal Map As XmlMap, ByVal Url As String, _
    Cancel As Boolean)

    MsgBox Map.Name & vbCrLf & Url
End Sub

Private Sub Workbook_BeforeXmlImport(ByVal Map As XmlMap, ByVal Url As String, _
    ByVal IsRefresh As Boolean, Cancel As Boolean)
    
    MsgBox IsRefresh & vbCrLf & _
        Map.Name & vbCrLf & _
        Url
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    MsgBox Sh.Name & " : " & Sh.Index
    
    'Exemple pour affecter un nouveau nom à la feuille créée
    'Sh.Name = "Nouveau nom"
End Sub

Private Sub Workbook_Open() 
    MsgBox "Bonjour " & Environ("UserName") 
End Sub

  Application.EnableEvents = False
    Workbooks.Open Filename:="C:\LeClasseur.xls"
  Application.EnableEvents = True

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

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim x As Long
    Dim lngColorIndex As Long
    
    'Désactive le menu contextuel
    Cancel = True
    
    'Affiche la palette couleur
    lngColorIndex = Application.Dialogs(xlDialogPatterns).Show
    
    'Récupére la couleur de cellule actuelle
    x = ActiveCell.Interior.ColorIndex
    
    If lngColorIndex = xlColorIndexAutomatic Then x = xlColorIndexNone
    ActiveCell.Interior.ColorIndex = x

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    'permet de sortir de la procédure si plus d'une cellule est sélectionnée 
    '(sinon la suite de la macro renvoie un message d'erreur)
    If Target.Count > 1 Then Exit Sub
    
    MsgBox "Vous venez de modifier la cellule " & Target.Address & _
        " (" & Target.Value & ")" & _
        " dans la feuille nommée " & Sh.Name
End Sub

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
    MsgBox Target.Address & vbCrLf & Target.SubAddress
End Sub

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
    MsgBox "Mise à jour " & Sh.Name & " / " & Target.Name
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    MsgBox "Vous avez sélectionné la cellule " & Target.Address & _
        " dans la feuille nommée " & Sh.Name
End Sub

'Renvoie un message d'alerte si la synchronisation échoue.
Private Sub Workbook_Sync(ByVal SyncEventType As Office.MsoSyncEventType)
    
    If SyncEventType = msoSyncEventDownloadFailed Or _
            SyncEventType = msoSyncEventUploadFailed Then _
            MsgBox "La synchronisation a échoué."

End Sub