Accueil
Accueil Le Club Delphi Kylix C C++ Java J2EE DotNET & C# Visual Basic Access Pascal Dev Web PHP ASP XML UML SQLSGBD Windows Linux Autres
logo
Sommaire > VBA > Astuces de programmation
        Comment faire deux timers différents sur un même formulaire ?
        Comment personnaliser les messages d'erreur ?
        Eviter le lancement de deux instances d'une base
        Comment exécuter du code automation plus rapidement ?
        Exécution d'une commande contenue dans une variable
        Exécuter une fonction à la fermeture d'Access
        Exécuter une procédure en appuyant sur les touches F1, F2, etc.
        Puis-je mettre plusieurs lignes de codes sur une seule ?
        Utilisation du if ... or ... or. Revenir à la ligne dans la condition pour rendre plus lisible.
        Sortir d'une boucle sur pression d'une touche déterminée du clavier
        Comment exécuter un code à la première exécution d'un programme ?
        Comment obtenir le temps d'exécution d'une partie de mon code ?
        Quitter Access avec docmd.quit ou Application.quit ?
        Comment commenter/dé commenter plusieurs lignes d'un coup ?
        Comment forcer Access à attendre la fin d'un traitement avant de continuer ?
        Comment accéder à la base de registre ?
        Modifier Option Général d'Access par le code
        Comment en VBA récupérer dans une variable le chemin d'une BDD si on connait uniquement son DSN ?
        Existe-t-il des outils permettant de faciliter le développement et l'entretien de bases de données Access ?
        Comment compacter la base de données en cours ?
        Lorsque dans le code une boucle un peu trop longue s'exécute (par ex. > 20 sec) la fenêtre access 'ne répond plus'... jusqu'à ce que le code soit terminé
        Comment retrouver le rang d'un objet au sein de la collection à laquelle il appartient ?
        Comment mesurer le temps d'exécution d'un morceau de code ?
        La méthode Find d'ADO ne s'applique qu'à une seule colonne, existe-t-il une alternative permettant d'utiliser plusieurs colonnes ?
        Comment compacter une base de données avec ADO ?
        Exécuter un code si une variable optionnelle est passée en paramètre d'une fonction
        Comment attribuer une icône à l'application par VBA
        Comment récupérer la date et l'heure de la dernière modification d'un Etat ou d'un Formulaire ?
        Comment récupérer la date et l'heure de la dernière modification d'un Etat et d'un Formulaire
        Comment formater les dates (en version US) pour les inclures dans une requête
        Comment lister les applications installées en VBA ?
        Comment suivre un lien Mailto par le code ?
        Comment avoir la couleur inverse exacte ?
        Comment faire disparaître le bouton minimise par VBA ?
        Comment faire une sauvegarde de la base Access en cours ?
        Comment avoir un bouton avec des couleurs et un curseur différent ?
        11.3.1. Conseils d'optimisation du code (2)
                A quoi sert 'Option Explicit' ?
                Comparaison entre les fonctions de domaine (DLookup, DMax, DCount ...) et les RecordSets. Performances ?

precedent    sommaire    suivant   


Comment faire deux timers différents sur un même formulaire ?
auteur : stephaneey
Vous pouvez tout regrouper dans votre premier timer.
Rien ne vous empêche de contrôler le temps qui passe et selon l'intervalle que vous veux, exécuter telle ou telle action dans votre timer.
En admettant que vous ayez un interval défini à 1000 pour votre timer. Il vous suffit de déclarer une variable publique dans votre module. Si vous avez une action à exécuter toutes les secondes, mettez simplement votre action sans contrôle et si vous avez une action à exécuter toutes les 2 sec, faites un test comme ceci: :
Public Sec as Integer ' déclaration de ta variable dans le module de classe
Dans la procédure d'évènement on Timer:
 'le code de ton action qui doit s'exécuter toutes les secondes
 'incrémentation de la variable
Sec = Sec+1
 'ici le code de l'actoin qui doit s'exécuter toutes les 2 sec

if((Sec mod 2)=0) then
 'ici l'action à effectuer toutes les 2 sec
end if 

Comment personnaliser les messages d'erreur ?
auteur : Team Access
En VBA, dans la gestion des erreurs il faut mettre :

Select Case err.number 
   Case x   'x est le numéro de l'erreur que vous voulez intercepter 
       MsgBox "LeMessage" 
 .... 
   Case Else 
       MsgBox err.number & " " & err.description  'pour les cas que vous n'aurez pas mentionnés.
End Select
Vous mettez autant de "case" (à la place des ...) qu'il y a d'erreurs que vous voulez gérer.

Comment récupérer le numéro de l'erreur ? Il est inscrit sur le message d'erreur lorsqu'il apparaît.

lien : Comment personnaliser le message d'erreur d'Access lors de doublons

Eviter le lancement de deux instances d'une base
auteur : Morsi
Cette méthode permet d'éviter le lancement de la même base plusieurs fois en locale. Pour lancer le test vous pouvez soit créer une macro autoexec, soit créer un formulaire de démarrage soit <F_Démarrage> et qui vérifie si la base est déjà ouverte :
   ' -- Evenement sur ouverture du formulaire 
Private Sub Form_Open(Cancel As Integer) 
If TestDDELink(Application.CurrentDb.Name) Then 
    MsgBox "Cette base est déja ouverte sur votre poste", VbInformation DoCmd.Quit 
End If 
End Sub 

Function TestDDELink(ByVal strNomApplication As String) As Integer 
Dim varCanalDDE As Long 
On Error Resume Next 
Application.SetOption "Ignore DDE Requests", True 
 ' -- Ouvrir un canal entre instance de la base 
varCanalDDE = DDEInitiate("MSAccess", strNomApplication) 
 ' -- Si la base n'est pas ouverte, pas de canal de communication entre deux instances 
If Err Then 
     TestDDELink = 0 
Else 
     TestDDELink = 1 
     DDETerminate varCanalDDE 
     DDETerminateAll 
End If 
Application.SetOption ("Ignore DDE Requests"), False 
End Function

Comment exécuter du code automation plus rapidement ?
auteur : Papy Turbo
Exécuter une routine VBA, instruction par instruction, sur un objet Automation (Excel ou autre) est extrêmement lent : le temps de passer la commande d'Access à Excel s'ajoute à chaque ligne de code.
Dans le cas de Word, Excel et autres, qui incorporent le langage VBA, l'astuce consiste à :
1- passer toutes les valeurs en un bloc (voir les diverses FAQs et articles existants : il y a plein de méthodes), donc une seule instruction,
2- recopier les instructions VBA dans une macro Word ou Excel ou...
3- lancer, par automation une seule instruction : exécution de la macro.
Cela complique un poil la gestion d'erreur, mais c'est évidemment beaucoup plus efficace, puisque c'est ensuite Excel (ou Word), tout seul, qui va exécuter la procédure...


Exécution d'une commande contenue dans une variable
auteur : stephaneey
Dim mycmd as String
mycmd = "DoCmd.OpenForm (\'table1\')"
Eval (mycmd) 

Exécuter une fonction à la fermeture d'Access
auteur : Etienne Bar
Le seul moyen d'y arriver est d'ouvrir à l'ouverture un formulaire invisible et de coder votre action de sortie sur l'événement de fermeture de ce formulaire.
Lorsque vous allez fermer Access, ce formulaire va se fermer et l'action de fermeture va s'exécuter. Bien sur, il ne faut pas que ce formulaire puisse être fermé par une action utilisateur c'est pour ça qu'il est préférable qu'il ne soit pas visible.


Exécuter une procédure en appuyant sur les touches F1, F2, etc.
auteur : FRED.G
Remarque préalable: La propriété KeyPreview (AperçuTouches) du formulaire doit être sur Oui.
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

  Select Case KeyCode
    Case vbKeyF1
      MsgBox "Vous avez appuyé sur F1"
    Case vbKeyF2
      MsgBox "Vous avez appuyé sur F2"
    Case vbKeyF3
      MsgBox "Vous avez appuyé sur F3"
    Case Else
      Exit Sub
  End Select
 'Ensuite on annule l'effet normal de la touche
  KeyCode = 0

End Sub
lien : faq Quelles sont les correspondances en VBA des touches ?

Puis-je mettre plusieurs lignes de codes sur une seule ?
auteur : Maxence HUBICHE
oui
Il suffit de séparer chaque instruction par le symbole :
A=B : C=D
Nous avons ici deux lignes de code en une.


Utilisation du if ... or ... or. Revenir à la ligne dans la condition pour rendre plus lisible.
auteur : Team Access
Il suffit de mettre un souligné en fin de ligne. Ne pas oublier de mettre un espace avant le souligné :

If X=3 _
Or X=8 Then 
... 
End If

Sortir d'une boucle sur pression d'une touche déterminée du clavier
auteur : Maxence HUBICHE
Vous mettez, dans votre module (formulaire) une variable de portée module, par exemple :
Dim mpbTouche As Boolean
Dans votre code, vous créez une procédure sur l'évènement KeyDown qui contiendra la ligne :
mpbTouche=(KeyCode=xxxx)
Où xxxx correspond au code de la touche que vous souhaitez intercepter (vous peux le tester avec un MsgBox pour le connaitre : MsgBox KeyCode).
Et dans votre boucle vous testez mpbTouche
Do
...
...
Loop until mpbTouche
mpbTouche=False 

Comment exécuter un code à la première exécution d'un programme ?
auteur : Jean-Marc Rabilloud
Il y a plusieurs méthodes pour faire cela. Habituellement on utilise un emplacement particulier du registre situé sous cette clé :
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\appname\section\key

Cette partie du registre est directement manipulable avec les quatre fonctions suivantes :

  • SaveSetting appname, section, key, value : permet de créer ou de modifier une clé du registre.
  • GetSetting(appname, section, key [, default]) ou GetAllSettings((appname, section) : permet de récupérer une ou des clés
  • DeleteSetting appname, section, key : supprime une clé.
Bien sûr, ces fonctions ne permettent pas une gestion complète du registre mais elles vous permettent de stocker quelques valeurs très simplement. C'est ce que nous allons faire avec le code suivant.
Private Sub Form_Load() 

'vérifie l'existence de la clé
If Len(GetSetting("MonAppli", "Demar", "DejaEx")) = 0 Then 
    'si elle n'existe pas création de celle-ci
    SaveSetting "MonAppli", "Demar", "DejaEx", "Vrai"
    'Le code placé ici ne s'exécutera qu'une fois
    MsgBox "Je n'apparaîtrais plus", vbInformation + vbOKOnly 
End If 

End Sub
lien : FAQ VB

Comment obtenir le temps d'exécution d'une partie de mon code ?
auteur : Romain Puyfoulhoux
Ajoutez cette déclaration au début de votre module :
Private Declare Function GetTickCount Lib "kernel32" () As Long
GetTickCount renvoie le nombre de millisecondes qui s'est écoulé depuis le démarrage du système. Appelez-la au début de votre code,
puis à la fin, et la différence entre les deux résultats vous donnera le nombre de millisecondes qui s'est écoulé entre les deux appels.
Dim Debut As Long, Fin As Long
Debut = GetTickCount()

'ici le code à chronométrer

Fin = GetTickCount()
MsgBox "Temps mis en millisecondes : " & Fin - Debut

si vous voulez un retour au format HH:MM:SS:
MsgBox "Temps Total d'exécution en HH:MM:SS -> " & TimeSerial(0, 0, (((Fin - Debut) / 1000)))
lien : FAQ VB
lien : faq Comment mesurer le temps d'exécution d'un morceau de code ?

Quitter Access avec docmd.quit ou Application.quit ?
auteur : Tofalu
Il vaut mieux utiliser la méthode Application.quit donc l'exécution est plus propre. La methode docmd.quit étant réservée à une compatibilité avec la version Access 95.

L'aide a écrit :

La méthode Quit de l'objet DoCmd a été ajoutée pour des raisons de compatibilité ascendante afin de pouvoir exécuter l'action Quitter dans du code Visual Basic dans Microsoft Access 95. Il vaut mieux que vous utilisiez plutôt la méthode Quit existante de l'objet Application.


Comment commenter/dé commenter plusieurs lignes d'un coup ?
auteur : Demco
Il existe des boutons pour cela qui ne sont pas directement accessibles.
Voici comment les faire apparaître :
  • allez dans un module (feuille de code)
  • sur la barre de menu faites : bouton droit / personnaliser...
  • catégorie Edition
  • dans la colonne de droite trouvez Commenter bloc
  • cliquez sur cette ligne, et faites glisser jusqu'à la barre d'Access (où on trouve le bouton exécuter etc).
  • réitérez l'opération pour Ne pas commenter bloc
Il ne vous reste alors qu'à sélectionner les lignes de code, appuyer sur le bouton Commenter bloc et le tour est joué !


Comment forcer Access à attendre la fin d'un traitement avant de continuer ?
auteur : Maxence HUBICHE
DoEvents sert à rendre la main temporairement au système qui, ainsi, peut exécuter des instructions de sa pile.
DoEvents sert en fait au 'multitache' de Windows. Sinon, l'exécution du code VBA a tendance à monopoliser la machine.

Pour essayer, créez deux zones de texte (txt1 et txt2) puis un bouton (btn1)
Placez ce code sur l'événement Click du bouton :
txt1 = "première zone remplie"
DoEvents
 'cette boucle sert à créer une attente entre les deux affectations
For i = 1 To 10000000
Next
txt2 = "seconde zone remplie"
Essayez ce code, puis enlevez la ligne DoEvents et essayez de nouveau. Sans DoEvents, les deux zones de texte affichent leur nouveau texte en même temps.

lien : Comment lancer un programme et attendre la fin de son exécution avant de continuer ?

Comment accéder à la base de registre ?
auteur : pokemoon94
Dim Ma_Clef As String 'Chemin de ma clef dans le registre
Dim WshShell As Object

Ma_Clef = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName"

Set WshShell = CreateObject("WScript.Shell")

MsgBox WshShell.RegRead(Ma_Clef)

Set WshShell = Nothing
On peut aussi utiliser les méthode RegWrite ou RegDelete.


Modifier Option Général d'Access par le code
auteur : Keops93
 'Code Valide pour Office XP !!! à vérifier pour les autres
 'Modifie les options générales d'ACCESS

SetOption "Confirm Action Queries", False             'Requetes Actions
SetOption "Confirm Document Deletions", False         'Suppression d'enregistrement
SetOption "Confirm Record Changes", False             'Modification d'enregistrement
SetOption "ShowWindowsInTaskbar", False               'Fenetres dans la barre des taches

Comment en VBA récupérer dans une variable le chemin d'une BDD si on connait uniquement son DSN ?
auteur : Lucifer
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyA" _
                        (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
                        (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
                         lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _
                        (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
                        lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Public Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _
                        (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
                        lpType As Long, lpData As Long, lpcbData As Long) As Long
Public Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _
                        (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
                        lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
         

 
'Constante RegQueryValueEx..
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003

Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_ARENA_TRASHED = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259

Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_ALL_ACCESS = &H3F

Public Const REG_OPTION_NON_VOLATILE = 0

Public Function ValeurRegistre(pRoot As Variant, pChemin As String, pcle As String) As String
On Error GoTo Err_ValeurRegistre
Dim RegCle As Long
Dim RegValeurS As String
Dim regvaleurL As Long
Dim nSize As Long
Dim pType As Long
Dim lrc As Long

RegOpenKeyEx pRoot, pChemin, RegCle

' Determine la taille et le type des données à lire
RegQueryValueExNULL RegCle, pcle, 0, pType, 0&, nSize
Select Case pType
   
    Case REG_SZ
         RegValeurS = String(nSize, 0)
         lrc = RegQueryValueExString(RegCle, pcle, 0, pType, RegValeurS, nSize)
         If lrc = ERROR_NONE Then
            ValeurRegistre = Left$(RegValeurS, nSize)
         Else
            Err.Raise 99999, , "Erreur provoquée"
         End If
         
    Case REG_DWORD
         lrc = RegQueryValueExLong(RegCle, pcle, 0, pType, regvaleurL, nSize)
         If lrc = ERROR_NONE Then
             ValeurRegistre = CStr(regvaleurL)
          Else
            Err.Raise 99999, , "Erreur provoquée"
         End If
    End Select
    RegCloseKey RegCle
   

   
Err_ValeurRegistre:
Select Case Err.Number
   Case 0, 20
   Case Else
      ValeurRegistre = ""
      End Select
Exit Function
End Function
Voici comment utiliser cette fonction dans le cas d'un DSN systeme:
ValeurRegistre(HKEY_LOCAL_MACHINE, "software\ODBC\ODBC.INI\TonDSN",  "DBQ")

Existe-t-il des outils permettant de faciliter le développement et l'entretien de bases de données Access ?
auteur : Maxence HUBICHE
Premier outil : MZTools


Il vous fera une recherche, un remplacement dans tout votre code de votre application si vous voulez, mais il n'ira pas jusqu'à chercher dans les contrôles, les requêtes,...
Il permet également l'insertion d'entête de procédure ou de module, la gestion d'erreur ...

Second outil : V-Tools


Il opère une recherche complète sur les propriétés, le code, les formulaires... bref très utile également.


Comment compacter la base de données en cours ?
auteur : Maxence HUBICHE
Pour MS Access 2000 et plus.
Vous trouverez ci-dessous une librairie qui vous permettra de compacter la base en cours.

lien : en TSI SOON (Shut One, Open New) database add-in

Lorsque dans le code une boucle un peu trop longue s'exécute (par ex. > 20 sec) la fenêtre access "ne répond plus"... jusqu'à ce que le code soit terminé
auteur : Maxence HUBICHE
L'utilisateur n'a alors aucune connaîssance de la progression du code, et pire, il croit (à tort) que l'application a planté !

Solutions :

1/ Utiliser le DoEvents pour que le processeur ne soit pas accaparé par la boucle.

Exemple :

While i>0
   i=i+1
   DoEvents
Wend
2/ Il existe des commandes diverses pour forcer la mise à jour de l'affichage (repeint par exemple, ou refresh... )

3/ Si malgré tout, cela n'est pas suffisant, il reste la vrai prog ! A savoir faire une DLL qui utilise un thread (ou des threads) bien à elle ... Mais là, bon courage !


Comment retrouver le rang d'un objet au sein de la collection à laquelle il appartient ?
auteur : Tofalu

Private Function GetIndiceInColl(oObject As Object, oColl As Collection) As Integer
Dim I As Integer
I = 1
'parcourt de la collection
While I <= oColl.Count And getIndice = 0
  If oColl(I) Is oObject Then GetIndiceInColl = I
  I = I + 1 'on incrémente le nombre d'objets
Wend
End Function


Sub test()
Dim C As New Collection
Dim O1 As New Classe1, O2 As New Classe1, O3 As New Classe1
'on ajoute des objets à une collection
C.Add O1
C.Add O2
C.Add O3
'On veut afficher le rang de l'objet <b>02</b> dans la collection <b>C</b>.
MsgBox GetIndiceInColl(O2, C)
End Sub

Comment mesurer le temps d'exécution d'un morceau de code ?
auteur : vmolines
Créer un module de classe clsMarqueur en collant :

Option Compare Database
Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Nom As String
Private Debut As Long
Private Fin As Long

Private Sub Class_Initialize()
    Debut = GetTickCount
End Sub

Public Property Get lDebut() As Long
    Let lDebut = Debut
End Property

Public Property Get lFin() As Long
    Let lFin = Fin
End Property

Public Sub SetFin()
    Fin = GetTickCount
End Sub

Public Function Duree() As Long
    Duree = Fin - Debut
End Function

Public Sub lNom(ByVal pNom As String)
   Nom = pNom
End Sub

Public Function getNom() As String
    getNom = Nom
End Function
Créer un module de classe clsMarqueurs en collant :

Option Compare Database
Option Explicit

Dim Marqueurs As New Collection

Private Sub Class_Initialize()
    Set Marqueurs = New Collection
End Sub

Public Sub ajouterMarqueur(ByVal pNomMarqueur As String)
    Marqueurs.Add New clsMarqueur, pNomMarqueur
    Marqueurs(pNomMarqueur).lNom (pNomMarqueur)
End Sub

Public Sub terminerMarqueur(ByVal pNomMarqueur As String)
    Marqueurs.Item(pNomMarqueur).SetFin
End Sub

Public Function dureeMarqueur(ByVal pNomMarqueur As String) As String
    dureeMarqueur = Marqueurs.Item(pNomMarqueur).sDuree
End Function

Private Sub Class_Terminate()
    Set Marqueurs = Nothing
End Sub

Public Sub rapportDebug()
    Dim mqr As clsMarqueur
   
    For Each mqr In Marqueurs
        Debug.Print mqr.getNom & " : " & mqr.Duree & "ms"
    Next
End Sub
Il s'agit de deux classe destinées à enregistrer des temps d'exécution à utiliser comme suit :

dim analyse as new clsMarqueurs

analyse.ajouterMarqueur("mon traitement1")
... 'Code du traitement 1
analyse.terminerMarqueur("mon traitement1")

analyse.ajouterMarqueur("mon traitement2")
... 'Code du traitement 2
analyse.terminerMarqueur("mon traitement2")

analyse.rapportDebug
Vous pouvez imbriquer les marqueurs si besoin. Le rapport debug affiche le nom de chaque marqueur avec le temps d'exécution entre le début et la fin.

lien : faq Comment obtenir le temps d'exécution d'une partie de mon code ?

La méthode Find d'ADO ne s'applique qu'à une seule colonne, existe-t-il une alternative permettant d'utiliser plusieurs colonnes ?
auteur : Tofalu
Le lien proposé ci-dessous vous donnera différentes alternatives possibles afin d'arriver à vos fins.

lien : fr Problème avec la méthode ADO Find

Comment compacter une base de données avec ADO ?
auteur : Tofalu
Bien qu'ADO ne fournisse pas de méthode agissant sur la structure du fichier mdb, il est possible d'utiliser JRO (Jet Réplication Object)

Pour cela ajouter une référence Microsoft JRO à vote projet et utiliser la syntaxe suivante :

Dim jro As jro.JetEngine
Set jro = New jro.JetEngine
jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\MaBase.mdb;Jet OLEDB:Database Password=test", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\MaBaseCompactee.mdb;Jet OLEDB:Engine Type=4;Jet OLEDB:Database Password=test"

Exécuter un code si une variable optionnelle est passée en paramètre d'une fonction
auteur : Cafeine
Dans la déclaration de votre fonction déclarez l'argument facultatif de cette façon :

 ...Optional ByVal strArg1 as String="<empty>"...
Puis dans votre fonction regardez la valeur de strArg1 :

Dim flagNonRenseigné As Boolean
flagNonRenseigné = False

If strArg1 = "<empty>" Then
 flagNonRenseigné = True
 strArg1 = ""
End If

Comment attribuer une icône à l'application par VBA
auteur : LedZeppII

Il faut utiliser la propriété AppIcon

Public Sub SetDBprop(propName As String, propType As DAO.DataTypeEnum, propVal As Variant)
Dim db As DAO.Database, p As DAO.Property
 
 Set db = CurrentDb
 Set p = Nothing
 On Error Resume Next
 Set p = db.Properties(propName)
 On Error GoTo 0
 If p Is Nothing And Not IsNull(propVal) Then
    Set p = db.CreateProperty(propName, propType, propVal)
    db.Properties.Append p
 End If
 
 If Not (p Is Nothing) Then
    If IsNull(propVal) Then
       db.Properties.Delete propName
    Else
       p = propVal
    End If
 End If
 
 db.Close
End SubA+

Pour attribuer l'icône :

Dim strIcon As String
 
strIcon = currentproject.Path & "\NomFichier.ico"
SetDBprop "AppIcon", dbText, strIcon
Application.RefreshTitleBar

Pour supprimer licône :

SetDBprop "AppIcon", dbText, Null
Application.RefreshTitleBar

Ce code peut être mis soit dans l'événement Sur Chargement du Formulaire d'ouvertre ou bien dans la macro Autoexec.

lien : src http://access.developpez.com/sources/index.php?page=acc#Optiondemarrage2

Comment récupérer la date et l'heure de la dernière modification d'un Etat ou d'un Formulaire ?
auteurs : Sierra.77, Morgan BILLY

Voici une solution simple pour récupérer la date et l'heure de la dernière modification d'un Etat ou d'un Formulaire.


Pour un Etat :
CurrentProject.AllReports("Mon Etat").DateModified

Pour un Formulaire :
CurrentProject.AllForms("Mon Formulaire").DateModified

Pour tous les Etats du projet en cours :
Dim acobjLoop As AccessObject
   
    For Each acobjLoop In CurrentProject.AllReports
        With acobjLoop
            Debug.Print .Name & " - Created " & .DateCreated & " - Modified " & .DateModified
        End With
    Next acobjLoop

Pour tous les Formulaires du projet en cours :
Dim acobjLoop As AccessObject
   
    For Each acobjLoop In CurrentProject.AllForms
        With acobjLoop
            Debug.Print .Name & " - Created " & .DateCreated & " - Modified " & .DateModified
        End With
    Next acobjLoop

Pour afficher cette information dans une zone de texte il faut inscrire à la propriété "Source contrôle" la ligne suivante :


Pour un Etat :

=CurrentProject.AllReports(Report.Name).DateModified

Pour un Formulaire :

=CurrentProject.AllReports(Forms.Name).DateModified
Autre méthode:
Sub DonneesEtat()

    Dim MyDb As DAO.Database
    Dim MyDocument As DAO.Document
   
    Set MyDb = CurrentDb()
   
    With MyDb
        For Each MyDocument In .Containers("Reports").Documents
            Debug.Print "Nom: " & MyDocument.name & "  Date de modification: " & MyDocument.LastUpdated
        Next
    End With
    
End Sub
lien : faq Comment récupérer la date et l'heure de la dernière modification d'un Etat et d'un Formulaire

Comment récupérer la date et l'heure de la dernière modification d'un Etat et d'un Formulaire
auteurs : Lou Pitchoun, Morgan BILLY
Sachant qu'il y a encore des utilisateurs d'Access 97, voici une solution :
Tout d'abord, créer une requête basée sur la table MSysObjects (table système (cachée) d'Access qui recense tous les objets de la base de données).
Cette requête sera appelée : DateModifEtat
SELECT MSysObjects.Type, MSysObjects.Name, MSysObjects.DateUpdate
FROM MSysObjects
WHERE (((MSysObjects.Type)=-32764));
Les Etats sont "reconnus" par le numéro de type -32764.
Les Formulaires sont "reconnus" par le numéro de type -32768.

Il suffit ensuite de parcourir cette requête pour récupérer la date de modification :
Sub DateModifEtat()
 
    Dim oRstDateUpdateReport As DAO.Recordset
    
    Set oRstDateUpdateReport = Application.CurrentDb.OpenRecordset("DateModifEtat")
 
    oRstDateUpdateReport.MoveFirst
    While Not oRstDateUpdateReport.EOF
        Debug.Print "Nom état : " & oRstDateUpdateReport![Name] & " - Date de modification : " & oRstDateUpdateReport![DateUpdate]
        oRstDateUpdateReport.MoveNext
    Wend
    
End Sub
Autre méthode :
Sub DonneesEtat()

    Dim MyDb As DAO.Database
    Dim MyDocument As DAO.Document
   
    Set MyDb = CurrentDb()
   
    With MyDb
        For Each MyDocument In .Containers("Reports").Documents
            Debug.Print "Nom: " & MyDocument.name & "  Date de modification: " & MyDocument.LastUpdated
        Next
    End With
    
End Sub


Ces deux méthodes fonctionnent avec toutes les versions D'access

lien : faq Comment récupérer la date et l'heure de la dernière modification d'un Etat ou d'un Formulaire ?
lien : faq Comment récupérer tous les noms des formulaire en VBA

Comment formater les dates (en version US) pour les inclures dans une requête
auteur : mout1234

Voici un code permettant de convertir une date Française vers une date US en la formatant pour l'insérer dans un chaîne SQL :
Function ap_SQLArgDate(ByVal vDate As Date) As String
On Error Resume Next
    If Not IsNull(vDate) Then
        ap_SQLArgDate = "#" & Format$(vDate, "mm/dd/yyyy") & "#"
    End If
End Function

Comment lister les applications installées en VBA ?
auteur : Cafeine

Ce code permet de lister dans un fichier les applications installées.
Il crée un fichier texte dans c:\temp\ appelé SoftwareList.txt
Sub ListSoft()
 
    strComputer = "."
    
    Set objWMIService = GetObject("winmgmts:" & _
        "{impersonationLevel=impersonate}!\\" & _
        strComputer & _
        "\root\cimv2")
    
    Set colSoftware = objWMIService.ExecQuery _
        ("SELECT * FROM Win32_Product")
    
    If colSoftware.Count > 0 Then
    
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objTextFile = objFSO.CreateTextFile( _
            "c:\temp\SoftwareList.txt", True)
    
        For Each objSoftware In colSoftware
            objTextFile.WriteLine objSoftware.Caption & vbTab & _
            objSoftware.Version
        Next
    
        objTextFile.Close
    
    Else
        WScript.Echo "Cannot retrieve software from this computer."
    
    End If
 
End Sub

Comment suivre un lien Mailto par le code ?
auteur : SpyesX

Utiliser la méthode FollowHyperlink de l'objet Application :
Application.FollowHyperlink "mailto:mailto:access@redaction-developpez.com"
lien : faq Suivre un lien hypertext par le code

Comment avoir la couleur inverse exacte ?
auteur : Cafeine
Lors d'un changement dynamique de la couleur de fond d'un contrôle, il peut s'avérer utile pour une meilleure lisibilité de modifier la police de caratère, pour cela utiliser la fonction suivante qui vous permet d'avoir en retour la couleur inverse de celle passée en paramètre
Option Explicit
 
Type Col_Sep
    red As Integer
    green As Integer
    blue As Integer
End Type
 
Function GetInverseColor(ByVal vbCol As Long) As Long
 
Dim colDecompose As Col_Sep
colDecompose = SepareColor(vbCol)
GetInverseColor = RGB(255 - colDecompose.red, 255 - colDecompose.green, 255 - colDecompose.blue)
 
End Function
 
 
Function SepareColor(ByVal ColRGB As Long) As Col_Sep
 
With SepareColor
    .red = Int(ColRGB And &HFF)
    .green = Int((ColRGB And &H100FF00) / &H100)
    .blue = Int((ColRGB And &HFF0000) / &H10000)
End With
 
End Function

Comment faire disparaître le bouton minimise par VBA ?
auteur : Arkham46
En fonction du mode d'affichage (maximiser ou non) ce code masque ou désactive les boutons.

Créer un nouveau module et coller le code ci-dessous
Option Compare Database
Option Explicit
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_SYSMENU = &H80000
 
Public Function BarButton(pFrm As Access.Form, pMinButton As Boolean, pMaxButton As Boolean, pAllButtons As Boolean)
Dim wStyle As Long
wStyle = GetWindowLong(pFrm.hwnd, GWL_STYLE)
wStyle = wStyle Or WS_SYSMENU Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX
If pAllButtons Then
  wStyle = wStyle Or WS_SYSMENU
Else
  wStyle = wStyle Xor WS_SYSMENU
End If
If pMaxButton Then
  wStyle = wStyle Or WS_MAXIMIZEBOX
Else
  wStyle = wStyle Xor WS_MAXIMIZEBOX
End If
If pMinButton Then
  wStyle = wStyle Or WS_MINIMIZEBOX
Else
  wStyle = wStyle Xor WS_MINIMIZEBOX
End If
Call SetWindowLong(pFrm.hwnd, GWL_STYLE, wStyle)
End Function
Appel de la fonction :
Private Sub Form_Load()
Call BarButton(Me, False,true,True)
End Sub

Comment faire une sauvegarde de la base Access en cours ?
auteur : LedZeppII
Ceci est un exemple VBScript qui fonctionne sous VBA :
Dim fso As Object, strDest As String
strDest = CurrentProject.Path & "\" & _
          Left(CurrentProject.Name, Len(CurrentProject.Name) - 4) & _
          ".bak." & Right(CurrentProject.Name, 3)
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile CurrentProject.FullName, strDest
Set fso = Nothing

Comment avoir un bouton avec des couleurs et un curseur différent ?
auteur : Starec
Ce code permet :
1 - D'avoir un bouton avec des couleurs
2 - De mettre une image sur ce bouton et du texte
3 - D'avoir un curseur différent quand la souris survole ce bouton
Il faut utiliser le bouton de commande MS Forms 2.0 CommandButton.
Pour mettre ce contrôle sur un formulaire, quand vous êtes en mode création, sélectionnez dans la liste des contrôle Active X : Microsoft Forms 2.0 CommandButton.
Ce contrôle est normalement installé en standard.

1 - Couleur :
Ce bouton possède une propriété Backcolor. Cepdendant lorsque vous êtes dans l'éditeur VBA, celle-ci ne s'affiche pas dans la liste, il faut entièrement la saisir.
Me.cmdFermer.BackColor = RGB(200, 200, 255)
Vous pouvez également utiliser les constantes VB (vbWhite, ...). Ce code est à mettre sur l'ouverture du formulaire.

2 - Image + Texte
Ce bouton vous permet également d'avoir une image et du texte (contrairement au bouton Access qui ne permet qu'un des deux à la fois).
Pour cela il faut que votre bouton ait une hauteur (propriété hauteur ou height) assez grande pour tout voir.
Voici un exemple de code :
With Me.CommandButton0
        .Picture = LoadPicture(Application.CurrentProject.Path & "\Data\turup.gif")
        .Caption = "Le Texte"
End With
Si vous ne voyez pas le texte agrandissez votre bouton en hauteur. Ce bouton a une propriété qui est PicturePosition, celle-ci se trouve dans l'onglet "Toutes" de la fenêtre des propriétés (en bas), cela vous permet de positionner votre image par rapport au texte. Ce code est à mettre sur l'ouverture du formulaire.

3 - Le curseur
Dans Windows vous avez un curseur qui s'appelle Harrow.cur, celui-ci représente une main. Je le copie toujours dans un répertoire (Data) situé dans le même répertoire que la base.
Ce qui me permet d'utiliser le code suivant
With Me.CommandButton0
        .MousePointer = 99
        .MouseIcon = LoadPicture(Application.CurrentProject.Path & "\Data\Harrow.cur")
End With
Ainsi quand la souris survole le bouton une main apparait, ce code est à mettre sur l'ouverture du formulaire.
Voilà, je pense que ces petites astuces (pour ceux qui ne connaissent pas), donneront un peu plus de cachet à vos applis.
Remarque : A partir de la version d'Access 2003, vous avez la possibilité d'avoir des boutons à la forme Windows XP. Par contre ce bouton restera malheureusement avec des angles vifs et non arrondis.
Beaucoup utilisent un label pour simuler un bouton de couleur, l'inconvénient c'est que l'on ne peux faire de focus dessus, et qu'il faut jouer sur l'apparence lors des clics pour pouvoir avoir l'aspect d'un bouton.


precedent    sommaire    suivant   

Consultez les autres F.A.Q's


Les sources présentés sur cette pages sont libre de droits, et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une oeuvre intellectuelle protégée par les droits d'auteurs. Copyright ©2004  Developpez LLC. Tout droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à 3 ans de prison et jusqu'à 300 000 E de dommages et intérets. Cette page est déposée à la SACD.

Vos questions techniques : forum d'entraide Accueil - Publiez vos articles, tutoriels, cours et rejoignez-nous dans l'équipe de rédaction du club d'entraide des développeurs francophones. Nous contacter - Copyright 2000..2005 www.developpez.com