I. Tables et champs▲
II. Requêtes▲
III. Formulaire et états▲
IV. Macros▲
V. VBA▲
V-A. Propositions générales▲
Avec le souci de conserver les anciennes entrées pour ne pas perdre les liens dans les messages sur les forums, il faudrait supprimer les mentions concernant les anciennes technos, notamment pour cocher la référence à une ancienne librairie comme DAO :
Microsoft DAO 3.x Object Library
V-B. Dates et heures▲
IV-B-1. Afficher des durées supérieures à 24 heures ? - [MAJ]▲
Afficher des durées supérieures à 24 heures ?
Peut-être rajouter une fonction qui calcule la durée entre 2 dates en HMS :
Public Function DureeHMS(ByVal dt1 As Date, ByVal dt2 As Date) As String
Dim h As Double, m As Double, s As Double
s = DateDiff("s", dt1, dt2) ' nombre de secondes entre les 2 dates
h = Int(Round(s / 3600#, 5)) ' nombre d'heures avec correction de l'opération portant sur des nombres en virgule flottante
s = s - h * 3600# ' reste de secondes après division entière
m = Int(Round(s / 60#, 5)) ' nombre de minutes dans le reste
s = s - m * 60# ' reste de secondes
' affichage du résultat HH:MM:SS
DureeHMS = h & ":" & Format(m, "00") & ":" & Format(s, "00")
End FunctionOu bien la durée entre deux dates en JHMS :
Public Function DureeJHMS(ByVal dt1 As Date, ByVal dt2 As Date) As String
Dim j As Double, h As Double, m As Double, s As Double
s = DateDiff("s", dt1, dt2) ' nombre de secondes entre les 2 dates
j = Int(Round(s / (3600# * 24#), 5)) ' nombre de jours avec correction de l'opération portant sur des nombres en virgule flottante
s = s - j * (3600# * 24#) ' reste de secondes
h = Int(Round(s / 3600#, 5)) ' nombre d'heures
s = s - h * 3600# ' reste de secondes
m = Int(Round(s / 60#, 5)) ' nombre de minutes dans le reste
s = s - m * 60# ' reste de secondes
' affichage du résultat HH:MM:SS
DureeJHMS = j & " jour(s) " & Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00")
End FunctionPeut-être avertir que comme les dates sont stockées sous forme de numériques (réels doubles) les opérations (addition, soustraction, etc..) portant sur ces nombres en virgule flottante peuvent entraîner des erreurs (avec un lien).
V-B-2. Comment calculer l'age d'une personne ? - [MAJ]▲
Comment calculer l'age d'une personne ?
Une petite explication au début sur ce que fait la fonction :
Il faut retrancher 1 à votre calcul si le mois en cours est inférieur au mois de la date de naissance, ou bien s'il est égal et si le jour d'aujourd'hui est inférieur au jour de la date de naissance :
Peut-être simplifier la 1re fonction :
Function CalculAge(ByVal Dat1 As Date, ByVal Dat2 As Date) As Integer
CalculAge = DateDiff("yyyy", Dat1, Dat2)
If (Month(Dat2) < Month(Dat1)) Or (Month(Dat2) = Month(Dat1)) And (Day(Dat2) < Day(Dat1)) Then
CalculAge = CalculAge - 1
End If
End FunctionPour la seconde fonction juste avertir que dans le cas où le 1er argument est omis, alors DateReference est égal à 0, ce qui équivaut à #30/12/1899# (Format(0,"dd/mm/yyyy"))
V-B-3. Comment éviter le problème de format de date (le jour et le mois sont parfois inversés) ? - [MAJ]▲
Comment éviter le problème de format de date (le jour et le mois sont parfois inversés) ?
Dim madate As Date
madate = Date
DoCmd.RunSQL "Insert into table1 (ladate) values(" & CDbl(madate) & ")"
DoCmd.RunSQL "Insert into table1 (ladate) values(#" & Format(madate,"mm/dd/yyyy") & "#)"
DoCmd.RunSQL "Insert into table1 (ladate) values('" & madate & "')"V-B-4. Comment savoir si un jour est ouvré ? - [MAJ + Nouvelles entrées]▲
Comment savoir si un jour est ouvré ?
Proposition d'ajout d'entrées :
Comment savoir si un jour est férié à partir des jours enregistrés dans une table ?
On dispose d'une table T_JoursFeries(JourFerie) pour enregistrer les jours fériés :
' la fonction renvoie True si le jour passé en argument est férié et false dans le cas contraire
Function EstFerie(ByVal dt As Date) As Boolean
EstFerie = Not IsNull(DLookup("JourFerie", "T_JoursFeries", "JourFerie=#" & Format(dt, "mm/dd/yyyy") & "#"))
End FunctionComment savoir si un jour est chômé à partir des périodes de congés enregistrées dans une table ?
On dispose d'une tableT_Conges(DateDebut, DateFin,..) pour enregistrer les périodes des différents congés :
' la fonction renvoie True si le jour passé en argument est chômé et false dans le cas contraire
Public Function EstConge(ByVal dt As Date) As Boolean
EstConge = Not IsNull(DLookup("DateDebut", "T_Conges", "#" & Format(dt, "mm/dd/yyyy") & "# between [DateDebut] and [DateFin]"))
End FunctionV-B-5. Déterminer la date du premier jour d'une semaine ? - [MAJ]▲
Déterminer la date du premier jour d'une semaine ?
Préciser que la 1ère semaine de l'année ISO correspond à la semaine du premier jeudi de l'année civile.
avec un lien :
https://fr.wikipedia.org/wiki/Num%C3%A9rotation_ISO_des_semaines
V-C. VBA -> SQL▲
V-C-1. Comment créer un jeu de données (Recordset) ? - [MAJ]▲
Comment créer un jeu de données (Recordset) ?
coquille avec '\' devant ' dans les critère du code SQL :
Sub DAOOpenRecordset ()
Dim db As DAO.Database, rst As DAO.Recordset, fld As DAO.Field
Dim sSQL As String
' Ouverture de la base de données
Set db = DBEngine.OpenDatabase (".\Comptoir.mdb")
sSQL = "Select * From CLIENTS Where Région= 'WA'"
' Ouverture du Recordset
Set rst = db.OpenRecordset (sSQL, dbOpenForwardOnly, dbReadOnly)
' Fermeture du Recordset
rst.Close
End SubPeut-être remplacer aussi Set db = DBEngine.OpenDatabase (".\Comptoir.mdb") par simplement set db = Currentdb.
V-C-2. Comment parcourir un jeu d'enregistrements (Recordset) ? - [MAJ]▲
Comment parcourir un jeu d'enregistrements (Recordset) ?
coquille au début du code + supprimer référence DAO :
If Not rst.EOF Then
rst.MoveFirst
While Not rst.Eof
' Code
rst.MoveNext
Wend
else
Msgbox "Le jeu d'enregistrements est vide"
End ifV-C-3. Comment exécuter une requête action (ajout, suppression ou mise à jour) ? - [MAJ]▲
Comment exécuter une requête action (ajout, suppression ou mise à jour) ?
coquille avec '\' dans les critère du SQL :
Sub DAOExecuteBulkOpQuery()
Dim db As DAO.Database
Set db = DBEngine.OpenDatabase (".\Comptoir.mdb")
' Exécution de la requête
db.Execute "Update CLIENTS Set PAYS = 'États-Unis' Where PAYS = 'USA'"
Debug.Print "Records Affected = " & db.RecordsAffected
db.Close
End SubPeut-être remplacer aussi Set db = DBEngine.OpenDatabase (".\Comptoir.mdb") par simplement Set db = Currentdb.
V-C-4. Pourquoi les messages d'avertissement n'apparaissent-ils pas lorsque j'exécute mes requêtes action en VBA ? - [MAJ]▲
Docmd.RunSql ""Update MATABLE Set MATABLE.[MONCHAMP] = ""DVP.COM"";"Guillemet en trop à gauche :
Docmd.RunSql "Update MATABLE Set MATABLE.[MONCHAMP] = ""DVP.COM"";"V-C-5. Comment insérer dans une table une chaîne de caractères contenant des quotes - [MAJ]▲
Comment insérer dans une table une chaîne de caractères contenant des quotes ?
La solution consiste à encadrer la chaîne par des guillemets :
val = "l'exemple"
set rst=currentdb.openrecordset("select * from Table1 where Champ1 like " & chr(34) & val & chr(34) & "V-C-6. Comment faire une requête qui recherche les doublons dans une table ? - [MAJ]▲
Comment faire une requête qui recherche les doublons dans une table ?
Count au lieu de sum + Having Count(TABLE1.CHAMP2)>1 pour ne garder que les doublons :
Select TABLE1.CHAMP1, Count(TABLE1.CHAMP2) AS CHAMP2 Into TABLE2
From TABLE1
Group By TABLE1.CHAMP1
Having Count(TABLE1.CHAMP2)>1
Order By TABLE1.CHAMP1V-C-7. Est-il possible de créer une requête paramétrée dont la valeur du paramètre proviendrait d'une variable ? - [MAJ]▲
Pas de déclaration de variables ni de libération de variable :
dim qdf as DAO.QueryDef
Set qdf= CurrentDb.QueryDefs("TA_REQUETE")
With qdf
.Parameters("TON_PARAM") = TaVariable
.Execute
End With
Set qdf= NothingProposition d'ajout :
Requête paramétré avec recordset :
dim qdf as DAO.QueryDef
dim rst as DAO.RecordSet
Set qdf= CurrentDb.QueryDefs("TA_REQUETE")
With qdf
.Parameters("TON_PARAM") = TaVariable
set rst = .OpenRecordSet()
End With
' ...
Set qdf= Nothing
Set rst= NothingV-D-8. Comment chercher les enregistrements contenant une certaine chaîne (like) ? - [MAJ]▲
Comment chercher les enregistrements contenant une certaine chaîne (like) ?
coquille avec '\' dans les critère du SQL :
requete = "Select * From carnet Where Prénom Like '*" & prenom & "*'"V-C-9. Comment filtrer les données en fonction de la valeur d'un paramètre ? - [Nouvelle entrée]▲
En utilisant la fonction Eval pour obtenir dans la chaîne SQL la valeur de la zone de texte :
Dim rst as DAO.RecordSet
Set rst = CurrentDb.OpenRecordset("select * from Table1 where champ1 = Eval('Forms!Formulaire1!ZoneTexte1');")
En déterminant à l'extérieur la valeur de ZoneTexte1 pour l'insérer ensuite dans la chaîne SQL :
Si le paramètre contient un numérique :
set rst=currentdb.openrecordset("select * from Table1 where Champ1 = " & forms!Formulaire1!ZoneTexte1 & ";")Si le paramètre contient du texte :
set rst=currentdb.openrecordset("select * from Table1 where Champ1 = " & chr(34) & forms!Formulaire1!ZoneTexte1 & chr(34) & ";")Si le paramètre contient une date :
set rst=currentdb.openrecordset("select * from Table1 where Champ1 = #" & Format(forms!Formulaire1!ZoneTexte1,"mm/dd/yyyy") & "#;")V-D. Numérotation enregistrements▲
V-D-1. Créer son propre numéro-auto - [Nouvelle entrée]▲
En local :
On dispose d'une table Chantiers(IdChantier, RefChantier, ...), IdChantier étant le champ de type entier long contenant la valeur à incrémenter :
Private Sub Form_BeforeUpdate(Cancel As Integer)
' procédure exécutée sur l'événement BeforeUpdate du formulaire F_Dossier
Dim cpt As Long ' compteur des numéros automatiques, valeur enregistrée dans la table CompteursIndices
Dim dbs As DAO.Database ' variable objet pour faire référence à la base de données
Dim rst As DAO.Recordset ' variable objet de type recordset basée sur la table CompteursIndices
If Me.NewRecord Then ' si on est en mode ajout
Set dbs = CurrentDb ' référence à la base de données courante
' ouverture du recordset basé sur la table CompteursIndicese filtrée en fonction du nom de la table
Set rst = dbs.OpenRecordset("select Max(IdChantier) As cpt from Chantier;", dbOpenDynaset)
If Not rst.EOF Then ' si un compteur existe pour la période
cpt = rst!cpt + 1 ' on évalue le prochain numéro à attribuer à l'enregistrement
Else ' sinon
' on ajoute la nouvelle période à la table des compteurs d'indices et on met le compteur à 1
cpt = 1 ' on repart de 1 pour une autre année
End If
Me.IdChantier = cpt ' on enregistre la valeur du nouveau numéro du chantier dans le champ IdChantier.
' libération des variables objet
rst.Close
Set rst = Nothing
Set dbs = Nothing
End If
End SubEn mode multiutilisateurs :
On dispose d'une table de compteur d'indice CompteursIndices(NomTable, CompteurIndice).
Un formulaire basé sur la table Chantiers avec sur l'événement avant insertion ce code qui permet d'incrémenter le compteur :
Private Sub Form_BeforeUpdate(Cancel As Integer)
' procédure exécutée sur l'événement BeforeUpdate du formulaire F_Dossier
Dim cpt As Long ' compteur des numéros automatiques, valeur enregistrée dans la table T_Compteur_Indice
Dim dbs As DAO.Database ' variable objet pour faire référence à la base de données
Dim rstCpt As DAO.Recordset ' variable objet de type recordset basée sur la table T_Compteur_Indice
If Me.NewRecord Then ' si on est en mode ajout
Set dbs = CurrentDb ' référence à la base de données courante
' ouverture du recordset basé sur la table CompteursIndicese filtrée en fonction du nom de la table
Set rstCpt = dbs.OpenRecordset("select compteurIndice from T_Compteur_Indice where NomTable like """ & Me.RecordSource & """", dbOpenDynaset)
If Not rstCpt.EOF Then ' si un compteur existe pour la période
cpt = rstCpt!CompteurIndice + 1 ' on évalue le prochain numéro à attribuer à l'enregistrement
rstCpt.Edit
rstCpt!CompteurIndice = cpt ' on met à jour le compteur d'indice avec le numéro
rstCpt.Update
Else ' sinon
' on ajoute la nouvelle période à la table des compteurs d'indices et on met le compteur à 1
cpt = 1 ' on repart de 1 pour une autre année
rstCpt.AddNew
rstCpt!NomTable = Me.RecordSource
rstCpt!CompteurIndice = cpt
rstCpt.Update
End If
Me.IdChantier = cpt ' on enregistre la valeur du nouveau numéro du chantier dans le champ IdChantier.
' libération des variables objet
rstCpt.Close
Set rstCpt = Nothing
Set dbs = Nothing
End If
End SubV-E. Opération sur les nombres▲
V-E-1. Comment convertir un nombre décimal en binaire ?▲
Comment convertir un nombre décimal en binaire ?
' convertit un entier décimal 11 en nombre binaire 1011
' suivant un schéma binaire : 11 = 1*2^3 + 0*2^2 + 1*2^1 + 1*2^0
Public Function DecimalToBinaire(ByVal NbreDec As Double) As String
' Variable/Indice de boucle et valeur binaire du digit correspondant
Dim IndicePos As Integer, ValDig As Integer
' Variable/Indice de poids fort du nombre binaire
Dim IndiceMax As Integer
' calcul l'indice de poids fort du nombre binaire avec correction des erreurs liées aux opérations en virgule flottante
If NbreDec > 0# Then IndiceMax = Int(Round(Log(NbreDec) / Log(2), 9))
For IndicePos = IndiceMax To 0 Step -1
ValDig = Int(NbreDec / (2# ^ IndicePos)) ' valeur binaire du digit de position IndicePos
DecimalToBinaire = DecimalToBinaire & ValDig
NbreDec = NbreDec - ValDig * (2# ^ IndicePos) ' reste de la division
Next IndicePos
End Function' convertit un entier décimal 11 en nombre binaire 1011
' suivant un schéma de horner : 11 = 1*2^3 + 0*2^2 + 1*2^1 + 1*2^0 = 1 + 2*(1 + 2*(0 + 2*1)
Public Function DecimalToBinaire2(ByVal NbreDec As Double) As String
' Variable/Indice de boucle et valeur binaire du digit correspondant
Dim IndicePos As Integer, ValDig As Integer
' Variable/Indice de poids fort du nombre binaire
Dim IndiceMax As Integer
' calcul l'indice de poids fort du nombre binaire avec correction des erreurs liées aux opérations en virgule flottante
If NbreDec > 0 Then IndiceMax = Int(Round(Log(NbreDec) / Log(2), 9))
For IndicePos = 0 To IndiceMax
ValDig = NbreDec - Int(NbreDec / 2#) * 2# ' reste de la division de NbreDec par 2
DecimalToBinaire2 = ValDig & DecimalToBinaire2
NbreDec = Int(NbreDec / 2#)
Next IndicePos
End FunctionV-E-2. Comment convertir un nombre binaire en décimal ? - [Nouvelle entrée] ▲
Proposition d'entrée :
Comment convertir un nombre binaire en décimal ?
' convertit un nombre binaire 1011 en nombre décimal 11
' suivant un schéma binaire : 11 = 1*2^3 + 0*2^2 + 1*2^1 + 1*2^0
Public Function BinaireToDecimal(ByVal NbreBin) As Double
' Variable/Indice de boucle
Dim IndicePos As Integer
' Variable/Indice de pois fort
Dim IndiceMax As Integer
' calcul du nombre de positions du résultat en binaire avec correction des erreurs liées aux opérations en virgule flottante
IndiceMax = Len(NbreBin) - 1
For IndicePos = 0 To IndiceMax
BinaireToDecimal = BinaireToDecimal + (Mid(NbreBin, IndiceMax - IndicePos + 1, 1) * (2 ^ IndicePos))
Next IndicePos
End FunctionV-E-3. Comment corriger les erreurs dans les résultats des opérations en virgule flottante ? - [Nouvelle entrée] ▲
Il faut arrondir le résultat en utilisant la fonction Rownd() :
resultat = Round(Resultat,5)V-F. Formulaires - Sous-formulaires▲
V-F-1. Faire référence à un contrôle dans un formulaire▲
Dans le formulaire actif pour copier dans une variable la valeur du contrôle nommé "total" :
val = Me!totalDans un formulaire ouvert nommé "frmFacture" :
val = Forms!frmFacture!totalV-F-2. Faire référence à un contrôle dans un sous-formulaire▲
Pour copier dans une variable la valeur du contrôle nommé "total" situé dans le sous-formulaire "sfrmDetailFacture" :
val = Me!sfrmDetailFacture.form!totalV-F-3. Exécuter une procédure contenue dans le module d'un sous-formulaire▲
Pour exécuter la procédure proc() situé dans le module du sous-formulaire actif sfrmDetailFacture :
M_sfrmDetailFacture.Proc()Autre possibilité :
Forms!frmFacture!sfrmDetailFacture.Form.Proc()V-G. Etats▲
V-G-1. Comment exporter un état au format Word ?▲
V-G-2. Comment exporter un état au format pdf ? - [Nouvelle entrée]▲
V-H. Interaction avec d'autres applications▲
V-H-1. Comment ouvrir un fichier HTML, Word, PDF ou autre en utilisant l'exécutable associé ?▲
V-H-2. Comment ouvrir un dossier à l'aide de la fonction Shell ? - [Nouvelle entrée]▲
Shell "explorer.exe " & Chr(34) & CheminDossier & Chr(34), vbMaximizedFocus ' on ouvre le dossier avec son cheminV-H-3. Comment ouvrir un fichier à l'aide de la fonction Shell ? - [Nouvelle entrée]▲
Shell "explorer.exe " & Chr(34) & CheminFichier & Chr(34), vbMaximizedFocus ' on ouvre le fichier avec son chemin