Quelques trucs VBA Sympa

F8 = Pas à pas, y compris dans les sous-routines
SHIFT F8 = Pas à pas, mais pas dans les sous-routines (Attention : Commencer par F8, sinon ça démarre pas)
CTRL F8 = Comme si c'était F5 jusqu'au prochain point d'arrêt, celui ci étant représenté par le clignotement du curseur

Sub ListeObjet()
    For ctr = 0 To Application.CurrentData.AllTables.Count - 1
      Debug.Print Application.CurrentData.AllTables(ctr).Name
      Debug.Print Application.CurrentData.AllTables(15).DateCreated
      Debug.Print Application.CurrentData.AllTables(15).DateModified
    Next
    For ctr = 0 To Application.CurrentData.AllQueries.Count - 1
      Debug.Print Application.CurrentData.AllQueries(ctr).Name
    Next
    For ctr = 0 To CurrentProject.AllForms.Count - 1
      Debug.Print CurrentProject.AllForms(ctr).Name
    Next
    For ctr = 0 To CurrentProject.AllReports.Count - 1
      Debug.Print CurrentProject.AllReports(ctr).Name
    Next
      For ctr = 0 To CurrentProject.AllMacros.Count - 1
      Debug.Print CurrentProject.AllMacros(ctr).Name
    Next

    ' Et même les imprimantes installées :
    For ctr = 0 To Application.Printers.Count - 1
      Debug.Print Application.Printers(ctr).DeviceName
    Next
End Sub

Sub ListeReferenceVBA()
    ' Listing de toutes les bibliothèques externes VBA
    For ctr = 1 To Application.References.Count
      Debug.Print Application.References(ctr).Name
      If Application.References(ctr).IsBroken Then Debug.Print "(Référence cassée)"
      Debug.Print Application.References(ctr).FullPath
    Next
End Sub

Sub ControleActif()
    ' Renvoie le nom ou la valeur du contrôle actif (Que ce soit une table, requête, formulaire):
    Debug.Print Application.Screen.ActiveControl.Name
    Debug.Print Application.Screen.ActiveControl ' Valeur (.value n'existe pas)
    ' Afin de connaître le champ d'avant celui sur lequel on pointe :
    MsgBox Screen.PreviousControl.Name
    ' Utile quand par exemple on a quelques champs, et un bouton marqué "Mettre en rouge"
    ' Si on veut que le bouton mette en reouge le champ sur lquel on était juste avant de cliquer
    ' Il faut bien connaitre ce "Previous control"
End Sub

Sub AfficheSablier()
    ' 11 = sablier. 0 = Par défaut.
    ' Il faut être dans un objet Access comme un formulaire pour le voir. Inutile de faire F5.
    Screen.MousePointer = 11
    Screen.MousePointer = 0
End Sub

Sub InfoGenerale()
    Debug.Print Application.ProductCode
    ' {95520700-006E-0000-0001-000000FFE10E}
    Debug.Print Application.Name
    ' Microsoft Access
    Debug.Print CurrentProject.FullName
    ' D:\Atelier\Base de données2.accdb
    Debug.Print CurrentProject.Path
    ' D:\Atelier
    Debug.Print CurrentProject.Name
    ' Base de données2.accdb
    Debug.Print Application.Version
    ' 12.0
    Debug.Print Application.Title
End Sub

Sub VariableTemporaire()
    Application.TempVars.Add "Voiture", "Ferrari"
    Application.TempVars.Add "Moto", "Honda"
    Application.TempVars.Add "Voiture", "BMW" ' Ecrase Ferrari
    Debug.Print Application.TempVars("Voiture")
    Debug.Print Application.TempVars.Count
End Sub

Sub Filtres()
    ' Méthode 1 :
    Me.Filter = "Domaine='Politique'" 
    Me.FilterOn = True
    ' Méthode 2 :
    DoCmd.ApplyFilter , "Domaine='Politique'"
    Me.FilterOn = False ' On enlève le filtre
End Sub

Sub Bip()
    DoCmd.Beep
End Sub

Sub CopieRenommeSupprimeObjet()
    DoCmd.CopyObject , "T_Backup", acTable, "T_Celebrite"
    DoCmd.DeleteObject acTable, "T_Inutile"
    DoCmd.Rename "T_NouveauNom", acTable, "T_AncienNom"
End Sub

Sub AllerControlePrecis()
    DoCmd.GoToControl "Prenom"
    ' Ou
    Me.Prenom.SetFocus
End Sub

Sub BloquePanneauNavigation()
    ' empêche de supprimer ou modifier des objets dans le panneau de navigation à gauche
    ' mais n'empêche pas de les ouvrir ou d'en créer de nouveaux
    DoCmd.LockNavigationPane True
    ' et débloque
    DoCmd.LockNavigationPane False
End Sub

Sub Ouverture()
    DoCmd.OpenTable "T_Table"
    DoCmd.OpenQuery "R_Requete"
    DoCmd.OpenForm "F_Formulaire"
    ' Impression directe : DoCmd.OpenReport "E_Celebrite", acViewNormal
    DoCmd.OpenReport "E_Etat", acViewPreview
    DoCmd.OpenReport "E_Celebrite", acViewReport ' Nouveau mode 2007 très pratique pour visualisation écran
    ' DoCmd.Openmacro n'existe pas
    DoCmd.RunMacro "M_Macro"
    DoCmd.OpenModule "P_Module", "UnCertainSub"
End Sub

Sub Exportation()
    ' Si le fichier existe, il est écrasé sans message
    DoCmd.OutputTo acOutputTable, "T_Celebrite", acFormatRTF, "d:\Atelier\machin.rtf"
    ' Exportation, avec ouverture dudit fichier :
    DoCmd.OutputTo acOutputForm, "F_Celebrite", acFormatPDF, "d:\Atelier\truc.pdf", True
    ' Exportation en vue d'envoi par e-mail :
    DoCmd.SendObject acSendTable, "T_Celebrite", acFormatXLS, "a@destinataire.com", "copie@dest.com", "bcc1@dest.com,bcc2@dest.com", "Titre", "Corps du message", False
End Sub

Sub Imprimer()
    ' Imprime l'objet courant
    DoCmd.PrintOut
End Sub

Sub DocmdRuncommand()
    ' Liste complète de tous les RunCommands : http://www.accessruncommand.com
    ' DoCmd.RunCommand
    ' Montrer la boîte de dialogue "A propos"
    DoCmd.RunCommand acCmdAboutMicrosoftAccess
    ' Exemple : Lance l'analyseur de tables
    Application.RunCommand acCmdAnalyzePerformance
End Sub

Sub Test()
    DoCmd.SearchForRecord
    DoCmd.FindRecord
End Sub