Access : les commandes intégrées des menus

'Affiche la boîte de dialogue A propos de Microsoft Access en utilisant le nom de la constante
Application.RunCommand acCmdAboutMicrosoftAccess
DoCmd.RunCommand acCmdAboutMicrosoftAccess
RunCommand acCmdAboutMicrosoftAccess

'Affiche la boîte de dialogue A propos de Microsoft Access en utilisant la valeur de la constante
Application.RunCommand 35
DoCmd.RunCommand 35
RunCommand 35

'Affiche l'état avec un grossissement de 100%
DoCmd.RunCommand acCmdZoom100

'Maximise la fenêtre de l'application Access
DoCmd.RunCommand acCmdAppMaximize

Private Sub Form_Open(Cancel As Integer)
    'Désactivation du bouton Restauration
    Me.cmdRestauration.Enabled = False
End Sub

Private Sub cmdRestauration_Click()
    'Le focus est passé au bouton Fermer pour éviter une erreur
    Me.cmdFermer.SetFocus
    'Modification du statut des boutons
    Me.cmdRestauration.Enabled = False
    Me.cmdDeplacer.Enabled = True
    Me.cmdTaille.Enabled = True
    Me.cmdAgrandissement.Enabled = True
    'Exécution de la commande
    DoCmd.RunCommand acCmdDocRestore
End Sub

Private Sub cmdDeplacer_Click()
    'Exécution de la commande
    DoCmd.RunCommand acCmdDocMove
End Sub

Private Sub cmdTaille_Click()
    'Exécution de la commande
    DoCmd.RunCommand acCmdDocSize
End Sub

Private Sub cmdAgrandissement_Click()
    'Le focus est passé au bouton Fermer pour éviter une erreur
    Me.cmdFermer.SetFocus
    'Modification du statut des boutons
    Me.cmdRestauration.Enabled = True
    Me.cmdDeplacer.Enabled = False
    Me.cmdTaille.Enabled = False
    Me.cmdAgrandissement.Enabled = False
    'Exécution de la commande
    DoCmd.RunCommand acCmdDocMaximize
End Sub

Private Sub cmdFermer_Click()
    'Exécution de la commande
    DoCmd.RunCommand acCmdClose
End Sub

Private Sub cmdFacture_Click()
    'Ouvre l'état facture en le maximisant
    DoCmd.OpenReport "rptFacture", acViewPreview
    DoCmd.Maximize
    'Ajustement à la fenêtre Access
    DoCmd.RunCommand acCmdFitToWindow
    'Applique le zoom sélectionné
    Select Case Me.cboZoom
        Case 50
            DoCmd.RunCommand acCmdZoom50
        Case 75
            DoCmd.RunCommand acCmdZoom75
        Case 100
            DoCmd.RunCommand acCmdZoom100
        Case 150
            DoCmd.RunCommand acCmdZoom150
        Case 200
            DoCmd.RunCommand acCmdZoom200
    End Select
End Sub

Private Sub cmdFacture_Click()
    'Ouvre l'état facture en le maximisant
    DoCmd.OpenReport "rptFacture", acViewPreview
    DoCmd.Maximize
    'Ajustement à la fenêtre Access
    DoCmd.RunCommand acCmdFitToWindow
    'Affiche le nombre de pages sélectionnées
    Select Case Me.cboNbPages
        Case 1
            DoCmd.RunCommand acCmdPreviewOnePage
        Case 2
            DoCmd.RunCommand acCmdPreviewTwoPages
        Case 4
            DoCmd.RunCommand acCmdPreviewFourPages
    End Select
End Sub

'Affiche la fenêtre d'aide d'Access
DoCmd.RunCommand acCmdAnswerWizard

'Ouvre le navigateur par défaut sur le site Office de Microsoft
DoCmd.RunCommand acCmdMicrosoftOnTheWeb

Private Sub cmdAnnuler_Click()
    On Error GoTo GestionErreurs
    'Exécution de la commande
	DoCmd.RunCommand acCmdUndo
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Annuler"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdPremier_Click()
    'Premier enregistrement
    DoCmd.RunCommand acCmdRecordsGoToFirst
End Sub

Private Sub cmdPrecedent_Click()
    'Enregistrement précédent
    DoCmd.RunCommand acCmdRecordsGoToPrevious
End Sub

Private Sub cmdSuivant_Click()
    'Enregistrement suivant
    DoCmd.RunCommand acCmdRecordsGoToNext
End Sub

Private Sub cmdDernier_Click()
    'Dernier enregistrement
    DoCmd.RunCommand acCmdRecordsGoToLast
End Sub

Private Sub cmdNouveau_Click()
    'Nouvel enregistrement
    DoCmd.RunCommand acCmdRecordsGoToNew
End Sub

Private Sub CmdCopier_Click()
    On Error GoTo GestionErreurs
    'Le focus est redonné au contrôle précédent
    Screen.PreviousControl.SetFocus
    'Le point d'insertion est placé au début de la zone à sélectionner
    Screen.ActiveControl.SelStart = 0
    'Sélection du nombre de caractères contenus dans le contrôle
    Screen.ActiveControl.SelLength = Len(Screen.ActiveControl)
    'Exécution de la commande
    DoCmd.RunCommand acCmdCopy
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Copier"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdCouper_Click()
    On Error GoTo GestionErreurs
    'Le focus est redonné au contrôle précédent
    Screen.PreviousControl.SetFocus
    'Le point d'insertion est placé au début de la zone à sélectionner
    Screen.ActiveControl.SelStart = 0
    'Sélection du nombre de caractères contenus dans le contrôle
    Screen.ActiveControl.SelLength = Len(Screen.ActiveControl)
    'Exécution de la commande
    DoCmd.RunCommand acCmdCut
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Couper"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdColler_Click()
    On Error GoTo GestionErreurs
    'Le focus est redonné au contrôle précédent
    Screen.PreviousControl.SetFocus
    'Exécution de la commande
    DoCmd.RunCommand acCmdPaste
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Coller"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdCollerAjout_Click()
    On Error GoTo GestionErreurs
    'Sélection de l'enregistrement
    DoCmd.RunCommand acCmdSelectRecord
    'Copie de l'enregistrement
    DoCmd.RunCommand acCmdCopy
    'Exécution de la commande
    DoCmd.RunCommand acCmdPasteAppend
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Coller par ajout"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdSupprimer_Click()
    On Error GoTo GestionErreurs
    'Désactive l'affichage des messages système
    DoCmd.SetWarnings False
    If MsgBox("Voulez-vous vraiment supprimer cet enregistrement ?", _
    vbQuestion + vbYesNo + vbDefaultButton2, "Suppression") = vbYes Then
        'Sélection de l'enregistrement
        DoCmd.RunCommand acCmdSelectRecord
        'Exécution de la commande
        DoCmd.RunCommand acCmdDeleteRecord
    End If
Exit_cmdSupprimer:
    'Réactive l'affichage des messages système
    DoCmd.SetWarnings True
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox _
            "La commande ""Supprimer l'enregistrement"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
            Resume Exit_cmdSupprimer
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
            Resume Exit_cmdSupprimer
    End Select
End Sub

Private Sub cmdRechercher_Click()
    'Le focus est redonné au contrôle précédent
    Screen.PreviousControl.SetFocus
    'Exécution de la commande
    DoCmd.RunCommand acCmdFind
End Sub

Private Sub cmdRemplacer_Click()
    'Le focus est redonné au contrôle précédent
    Screen.PreviousControl.SetFocus
    'Exécution de la commande
    DoCmd.RunCommand acCmdReplace
End Sub

Private Sub cmdActualiser_Click()
    On Error GoTo GestionErreurs
    'Exécution de la commande
    DoCmd.RunCommand acCmdRefresh
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Actualiser"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdFiltrerSelection_Click()
    On Error GoTo GestionErreurs
    'Le focus est redonné au contrôle précédent
    Screen.PreviousControl.SetFocus
    'Exécution de la commande
    DoCmd.RunCommand acCmdFilterBySelection
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Filtrer par sélection"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdFiltrerHorsSelection_Click()
    On Error GoTo GestionErreurs
    'Le focus est redonné au contrôle précédent
    Screen.PreviousControl.SetFocus
    'Exécution de la commande
    DoCmd.RunCommand acCmdFilterExcludingSelection
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Filtrer hors sélection"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdSaisieDonnees_Click()
    On Error GoTo GestionErreurs
    'Exécution de la commande
    DoCmd.RunCommand acCmdDataEntry
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Saisie de données"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdSauvegarder_Click()
    On Error GoTo GestionErreurs
    'Exécution de la commande
    DoCmd.RunCommand acCmdSaveRecord
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Sauvegarder l'enregistrement"" n'est pas" & vbNewLine & _
            "disponible pour l'instant !", vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdAfficherEnregistrements_Click()
    On Error GoTo GestionErreurs
    'Exécution de la commande
    DoCmd.RunCommand acCmdRemoveFilterSort
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Afficher tous les enregistrements"" n'est pas" & vbNewLine & _
            "disponible pour l'instant !", vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdTriCroissant_Click()
    On Error GoTo GestionErreurs
    'Le focus est redonné au contrôle précédent
    Screen.PreviousControl.SetFocus
    'Exécution de la commande
    DoCmd.RunCommand acCmdSortAscending
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Tri croissant"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdTriDecroissant_Click()
    On Error GoTo GestionErreurs
    'Le focus est redonné au contrôle précédent
    Screen.PreviousControl.SetFocus
    'Exécution de la commande
    DoCmd.RunCommand acCmdSortDescending
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Tri décroissant"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

'Affiche les fenêtres ouvertes en cascade
DoCmd.RunCommand acCmdWindowCascade

'Affiche les fenêtres ouvertes en mosaïque horizontale
DoCmd.RunCommand acCmdTileHorizontally

'Affiche les fenêtres ouvertes en mosaïque verticale
DoCmd.RunCommand acCmdTileVertically

Private Sub cmdAfficherProprietes_Click()
    On Error GoTo GestionErreurs
    'Exécution de la commande
    DoCmd.RunCommand acCmdDatabaseProperties
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Propriétés de la base"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdQuitterAccess_Click()
    On Error GoTo GestionErreurs     
    'Quitter Access
    DoCmd.RunCommand acCmdQuit
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Quitter"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select    
End Sub

Private Sub cmdColonne_Click()
    On Error GoTo GestionErreurs
    'Le focus est donné au sous-formulaire
    Me.ctlDetailCommande.SetFocus
    'Test du libellé du bouton
    If Me.cmdColonne.Caption = "Figer les colonnes" Then
        'Exécution de la commande "Figer les colonnes"
        DoCmd.RunCommand acCmdFreezeColumn
        'Modification du libellé du bouton
        Me.cmdColonne.Caption = "Libérer les colonnes"
    Else
        'Exécution de la commande "Libérer les colonnes"
        DoCmd.RunCommand acCmdUnfreezeAllColumns
        'Modification du libellé du bouton
        Me.cmdColonne.Caption = "Figer les colonnes"
    End If
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande spécifiée n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdExport_Click()
    On Error GoTo GestionErreurs
    'Exécution de la commande
    DoCmd.RunCommand acCmdOutputToExcel
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Analyse avec Microsoft Excel"" n'est pas" & vbNewLine & _
            "disponible pour l'instant !", vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub

Private Sub cmdVerifierOrtho_Click()
    On Error GoTo GestionErreurs
    'Le focus est donné au champ Mémo
    Me.txtMemo.SetFocus
    'Le point d'insertion est placé au début du champ
    Me.txtMemo.SelStart = 0
    'Sélection du texte contenu dans le champ
    Me.txtMemo.SelLength = Len(Me.txtMemo)
    'Exécution de la commande
    RunCommand acCmdSpelling
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case 2046
            'Affichage d'un message
            MsgBox "La commande ""Orthographe"" n'est pas disponible pour l'instant !", _
            vbInformation, "Erreur !"
        Case Else
            MsgBox "Une erreur inattendue s'est produite !" & vbNewLine & "Erreur no : " _
            & Err.Number & vbNewLine & Err.Description, vbCritical, "Erreur !"
    End Select
End Sub