FAQ MS-Access
FAQ MS-AccessConsultez toutes les FAQ
Nombre d'auteurs : 140, nombre de questions : 926, dernière mise à jour : 15 juin 2021
Sommaire→VBA→Astuces de programmation- Comment faire deux timers différents sur un même formulaire ?
- Comment personnaliser les messages d'erreur ?
- Comment éviter 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
- Comment exécuter une fonction à la fermeture d'Access ?
- Comment exécuter une procédure en appuyant sur les touches F1, F2, etc. ?
- Puis-je mettre plusieurs instructions sur une seule ligne de code ?
- Comment répartir sur plusieurs lignes le code d'une instruction pour le rendre plus lisible ?
- Comment 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 ?
- Vaut-il mieux 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 ?
- Comment modifier les options générales d'Access par le code ?
- Comment en VBA récupérer dans une variable le chemin d'une BDD si on connaît 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 ?
- Comment éviter la fenêtre « Access ne répond plus… » jusqu'à ce que le code soit exécuté dans une longue boucle (par ex. plus que 20 secondes) ?
- 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 autre option permettant d'utiliser plusieurs colonnes ?
- Comment compacter une base de données avec ADO ?
- Comment 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 état ou d'un formulaire ?
- Comment récupérer la date et l'heure de la dernière modification d'un état et d'un formulaire ?
- Comment formater les dates (en version US) pour les inclure 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 Réduire 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)
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 choisissez, d'exécuter telle ou telle action dans votre Timer.
En admettant que vous ayez un intervalle 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 deux secondes, faites un test comme ceci :
Public Sec as Integer ' Déclaration de la variable dans le module de classeDans la procédure d'événement on Timer :
' Le code de l'action qui doit s'exécuter toutes les secondes
'Incrémentation de la variable
Sec = Sec+1
if((Sec mod 2)=0) then
' Ici l'action à effectuer toutes les deux secondes
end ifEn VBA, pour 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 SelectVous 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 ?
Cette méthode permet d'éviter le lancement de la même base plusieurs fois en local. 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 :
' -- Événement sur ouverture du formulaire
Private Sub Form_Open(Cancel As Integer)
If TestDDELink(Application.CurrentDb.Name) Then
MsgBox "Cette base est déjà 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 instances 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 FunctionExé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 FAQ 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...
Dim mycmd as String
mycmd = "DoCmd.OpenForm ('table1')"
Eval (mycmd)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 sûr, il ne faut pas que ce formulaire puisse être fermé par une action de l'utilisateur c'est pour ça qu'il est préférable que ce formulaire ne soit pas visible.
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 SubLien : Quelles sont les correspondances en VBA des touches ?
Pour cela, il suffit de séparer chaque instruction par le symbole " : "
A=B : C=DNous avons ainsi deux lignes de code en une.
Il suffit de mettre un souligné en fin de ligne. Ne pas oublier de mettre un espace avant le souligné (underscore) :
If X=3 _
Or X=8 Then
...
End IfVous mettez, dans votre module (formulaire) une variable de portée module, par exemple :
Dim mpbTouche As BooleanDans 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 pouvez le déterminer avec un MsgBox : MsgBox KeyCode).
Et dans votre boucle vous testez mpbTouche
Do
...
...
Loop until mpbTouche
mpbTouche=FalseIl 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é.
Si ces fonctions ne permettent pas une gestion complète du registre, elles permettent néanmoins de stocker quelques valeurs très simplement. C'est ce que nous pouvons 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îtrai plus", vbInformation + vbOKOnly
End If
End SubLien : FAQ VB
Ajoutez cette déclaration au début de votre module :
Private Declare Function GetTickCount Lib "kernel32" () As LongGetTickCount 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 : Comment mesurer le temps d'exécution d'un morceau de code ?
Il vaut mieux utiliser la méthode Application.quit dont l'exécution est plus propre. La méthode docmd.quit étant réservée à une compatibilité avec la version Access 95.
L'aide Access mentionne :
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.
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 : [ALT + F11]) ;
- sur la barre de menu faites : bouton droit / Personnaliser... ;
- catégorie Édition ;
- 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é !
DoEvents sert à rendre la main temporairement au système qui, ainsi, peut exécuter des instructions de sa pile.
DoEvents sert en fait au « multitâche » 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 Sur clic 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 ?
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 = NothingOn peut aussi utiliser les méthodes RegWrite ou RegDelete.
' Code valide pour Office XP !!! À vérifier pour les autres
' Modifie les options générales d'Access
SetOption "Confirm Action Queries", False ' Requêtes Actions
SetOption "Confirm Document Deletions", False ' Suppression d'enregistrement
SetOption "Confirm Record Changes", False ' Modification d'enregistrement
SetOption "ShowWindowsInTaskbar", False ' Fenêtres dans la barre des tachesPublic 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
' Détermine 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 FunctionVoici comment utiliser cette fonction dans le cas d'un DSN système :
ValeurRegistre(HKEY_LOCAL_MACHINE, "software\ODBC\ODBC.INI\TonDSN", "DBQ")Premier outil : MZTools.
Site web où trouver cet outil.
Il exécutera une recherche, et le cas échéant un remplacement dans tout le code de votre application mais il n'ira pas jusqu'à chercher dans les contrôles, les requêtes...
Il permet également l'insertion d'en-tête de procédure ou de module, la gestion d'erreurs...
Second outil : V-Tools.
Site web où trouver cet outil.
Très utile également, il opère une recherche complète sur les propriétés, le code, les formulaires...
Pour MS Access 2000 et plus.
Vous trouverez ci-dessous une bibliothèque qui vous permettra de compacter la base en cours.
L'utilisateur n'a aucune connaissance 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
Wend2/ Il existe des commandes diverses pour forcer la mise à jour de l'affichage (Repaint par exemple, ou Refresh... ).
3/ Si malgré tout, cela n'est pas suffisant, il reste la vraie programmation ! À savoir faire une DLL qui utilise un thread (ou des threads) bien à elle... Mais là, bon courage !
Private Function GetIndiceInColl(oObject As Object, oColl As Collection) As Integer
Dim I As Integer
I = 1
' Parcours 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 SubCré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 FunctionCré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 SubIl s'agit de deux classes 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.rapportDebugVous 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 : Comment obtenir le temps d'exécution d'une partie de mon code ?
Le lien proposé ci-dessous vous donnera différentes options permettant d'arriver à vos fins.
Bien qu'ADO ne fournisse pas de méthode agissant sur la structure du fichier .mdb, il est possible d'utiliser JRO (Jet Replication Objects).
Pour cela ajoutez une référence Microsoft JRO à vote projet et utilisez 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"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
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 l'icône :
SetDBprop "AppIcon", dbText, Null
Application.RefreshTitleBar
Ce code peut être mis soit dans l'événement Sur Chargement du formulaire d'ouverture ou bien dans la macro Autoexec.
Lien : https://access.developpez.com/sources/index.php?page=acc#Optiondemarrage2
Voici une solution simple pour récupérer la date et l'heure de la dernière modification d'un état ou d'un formulaire.
Pour un état :
CurrentProject.AllReports("Mon État").DateModified
Pour un formulaire :
CurrentProject.AllForms("Mon Formulaire").DateModified
Pour tous les états 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 état :
=CurrentProject.AllReports(Report.Name).DateModified
Pour un formulaire :
=CurrentProject.AllReports(Forms.Name).DateModifiedAutre 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 SubLien : Comment récupérer la date et l'heure de la dernière modification d'un état et d'un formulaire ?
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 états 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 SubAutre 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 : Comment récupérer la date et l'heure de la dernière modification d'un état ou d'un formulaire ?
Lien : Comment récupérer tous les noms des formulaires en VBA ?
Voici un code permettant de convertir une date française vers une date US en la formatant pour l'insérer dans une 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
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
Utiliser la méthode FollowHyperlink de l'objet Application :
Application.FollowHyperlink "mailto:contact@votresite.com"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 caractères, 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 FunctionEn 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 FunctionAppel de la fonction :
Private Sub Form_Load()
Call BarButton(Me, False,true,True)
End SubCeci 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 = NothingCe 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ôles 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. Cependant, 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 WithSi 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 WithAinsi quand la souris survole le bouton une main apparaît, 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 : à 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 peut faire de focus dessus, et qu'il faut jouer sur l'apparence lors des clics pour pouvoir avoir l'aspect d'un bouton.