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→Manipulation des données→Manipulation des données Trucs et Astuces- Comment convertir une date d'un format UNIX en format français ?
- Comment créer un password ou un code (chiffres + lettres) en VBA ?
- Comment calculer le résultat d'un tarif à la seconde à partir d'un tarif et d'une heure ?
- Comment calculer le nombre de jours ouvrables entre deux dates ?
- Comment connaître le séparateur décimal ?
- Comment transformer des centièmes de seconde en minutes, secondes et centièmes ?
- Comment effectuer un calcul statistique à partir des valeurs contenues dans un tableau ?
- Comment optimiser l'ajout sur une grande table dans un Recordset DAO ?
- Comment faire un Update d'enregistrements non directement modifiables ?
- Comment enlever le trait de séparation entre la zone en-tête de formulaire et la zone détail de ce même formulaire ?
Les dates UNIX sont exprimées en secondes écoulées depuis le 01/01/1970.
Il est donc possible de convertir une telle date en utilisant la fonction DateAdd.
Function convertDateUnix(lngDate As Long)
convertDateUnix = DateAdd("s", lngDate, #1/1/1970#)
End FunctionPour le nombre aléatoire :
Int(Rnd * 1000)En ce qui concerne les lettres, on peut créer une table (T_Lettre) contenant toutes les lettres et avec identifiant 1, 2, 3...
MPD de la table : T_Lettre(NumLettre, Lettre).
Ensuite :
mdp = DLookup("Lettre", "T_Lettres", "NumLettre = " & Int(Rnd * 26 + 1))Donc la variable mdp contient une lettre aléatoire. Vous pouvez le faire le nombre de fois souhaité.
Pour avoir une procédure qui choisit aussi bien des lettres que des chiffres, on peut ajouter les 10 chiffres dans la table (on a donc 36 enregistrements dans la table).
Ensuite :
Dim i As Integer
'Mot de passe de 10 caractères
For i = 0 To 9
mdp = DLookup("caractere", "password", "id = " & Int(Rnd * 36 + 1))
provi = provi & mdp
Next i
pass = proviDans cet exemple, il s'agit d'un tarif à la seconde :
Public Sub multi_heure()
Dim heure As Date
Dim prix As Integer
Dim resultat As Single
heure = "05:30:00"
prix = 3
' Pour les heures
resultat = Hour(heure) * prix
resultat = resultat + Minute(heure) / 60 * prix
End SubIl faut mettre bAvecJFerie à False pour ne pas tenir compte des jours fériés, rien sinon.
Function Work_Days(BegDate As Variant, EndDate As Variant, _
Optional bAvecJFerie As Boolean = True) As Variant
Dim dt As Date
On Error GoTo Work_Days_Error
If IsNull(BegDate) Or IsNull(EndDate) Then Err.Raise vbObjectError + 1
If Not IsDate(BegDate) Or Not IsDate(EndDate) Then Err.Raise vbObjectError + 2
If BegDate > EndDate Then Err.Raise vbObjectError + 3
dt = BegDate
Work_Days = 0
While dt <= EndDate
If DatePart("w", dt, vbMonday) < 6 And IIf(bAvecJFerie, Not EstFerie(dt), True) Then
Work_Days = Work_Days + 1
End If
dt = DateAdd("d", 1, dt)
Wend
Exit Function
Work_Days_Error:
Select Case Err.Number
Case vbObjectError + 1: Work_Days = "Les 2 dates sont obligatoires."
Case vbObjectError + 2: Work_Days = "Format de date incorrect."
Case vbObjectError + 3: Work_Days = "La date de fin doit être postérieure à la date de début."
Case Else: Work_Days = Err.Description
End Select
End Function
Function EstFerie(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 11) As Date
Dim i As Integer
anneeDate = Year(QuelleDate)
joursFeries(1) = DateSerial(anneeDate, 1, 1)
joursFeries(2) = DateSerial(anneeDate, 5, 1)
joursFeries(3) = DateSerial(anneeDate, 5, 8)
joursFeries(4) = DateSerial(anneeDate, 7, 14)
joursFeries(5) = DateSerial(anneeDate, 8, 15)
joursFeries(6) = DateSerial(anneeDate, 11, 1)
joursFeries(7) = DateSerial(anneeDate, 11, 11)
joursFeries(8) = DateSerial(anneeDate, 12, 25)
joursFeries(9) = fLundiPaques(anneeDate)
joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Pâques + 38
joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Pâques + 49
For i = 1 To 11
If QuelleDate = joursFeries(i) Then
EstFerie = True
Exit For
End If
Next
End Function
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
' Adapté de plusieurs scripts...
Dim L(6) As Long, Lj As Long, Lm As Long
L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
L(4) = (19 * L(1) + 24) Mod 30
L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
L(6) = 22 + L(4) + L(5)
If L(6) > 31 Then
Lj = L(6) - 31
Lm = 4
Else
Lj = L(6)
Lm = 3
End If
' Lundi de Pâques = Paques + 1 jour
fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
End FunctionAttention : cet article prend en compte le lundi de Pentecôte qui n'est à ce jour plus férié.
Function GiveSep() As String
GiveSep = Mid(3 / 2, 2, 1)
End FunctionEn VBA :
Format(Int(Resultat \ 6000), "00") & ":" & Format(Int((Resultat Mod 6000) \ 100), "00") & ":" & Format(Int((Resultat Mod 6000) Mod 100), "00")En Access :
Format(Ent(Resultat \ 6000); "00") & ":" & Format(Ent((Resultat Mod 6000) \ 100); "00") & ":" & Format(Ent((Resultat Mod 6000) Mod 100); "00")Voici par exemple une fonction pour calculer un écart type sur les valeurs contenues dans un tableau :Public Function EcartTypeP(tbl As Variant) As Double
Dim Var1, Var2
For i = 1 To UBound(tbl)
Var1 = Var1 + (tbl(i) * tbl(i)) ' Somme des carrés
Var2 = Var2 + tbl(i) ' Somme des valeurs
Next
EcartTypeP = Sqr(((UBound(tbl) * Var1) - (Var2 * Var2)) / (UBound(tbl) * UBound(tbl)))
End Function
Voici le code à mettre afin de tester cette fonction. Nous remplissons tout d'abord un tableau pour ensuite en calculer l'écart type dont le résultat s'affichera dans la fenêtre d'exécution.
Private Sub Bouton1_Click()
Dim table(10)
' Remplir le tableau
For i = 1 To 10
table(i) = i
Next
' Dans un module faites Ctrl + G pour afficher la fenêtre d'exécution
Debug.Print EcartTypeP(table)
End SubPour exécuter ce code, il faut activer la référence : Microsoft DAO 3.x Object Library.
Si vous voulez insérer des données dans une table extrêmement importante (exemple : 100 000 lignes), vous utilisez certainement ceci :
Set oRst=CurrentDb.OpenRecordset("MaTable")
oRst.AddNew
Or, plus le jeu d'enregistrements d'un Recordset est gros, plus celui-ci mettra de temps à se charger.
L'idée est de restreindre le jeu de données du Recordset en créant une requête :
SELECT * FROM MATABLE WHERE 1=0
Bien entendu cette requête ne retourne rien. Un Recordset sur celle-ci sera donc très léger.
Set oRst=CurrentDb.OpenRecordset("MaRequete")
oRst.AddNew
Les enregistrements sont envoyés dans la table MaTable et le contenu de celle-ci n'a pas été chargé. L'ajout est optimal.
Lien : Définition et manipulation de données avec DAO par Tofalu
Lien : Comment déclarer une référence dans MS Access ?
Cas rencontré sur des tables attachées ODBC, où on ne peut pas modifier directement le contenu de certains champs car ces champs
sont des SortItems ou bien des SearchItems (Bases Image sur HP3000).
Il faut alors supprimer l'enregistrement puis le réécrire avec la nouvelle valeur du champ en question.
- - nom de la table ;
- - condition donnant la portée des modifications ;
- - nom du champ dont le contenu est à modifier ;
- - nouvelle valeur du champ.
Sub dt_update(table As String, filtre As String, champ As String, valeur As Variant)
'
' table : table lue, supprimée et modifiée
' filtre : condition permettant de sélectionner les enregistrements à modifier
' attention : si critère String : cod_art='toto'
' champ : nom du champ dont la valeur doit être modifiée
' valeur : nouvelle valeur du champ précité
'
' on ouvre deux fois la table :
' une fois au travers d'une requête qui filtre les enregistrements à traiter pour mémo/delete
' une fois en direct pour l'écriture
Dim instsql As String
Dim i As Byte
Dim db As DATABASE
Dim dt As Recordset, dt2 As Recordset
instsql = "select * from " & table & " where " & filtre & ";"
Set db = DBEngine.Workspaces(0).Databases(0)
' Sélection pour copie et suppression
Set dt = db.OpenRecordset(instsql, DB_OPEN_DYNASET)
' Pour écrire
Set dt2 = db.OpenRecordset(table, DB_OPEN_DYNASET)
dt.MoveFirst
Do Until dt.EOF
' Mémo
dt2.AddNew
For i = 0 To dt.Fields.Count - 1
dt2(i) = dt(i)
Next i
' modification du champ
dt2(champ) = valeur
' Suppression de l'ancien
dt.Delete
dt2.Update
dt.MoveNext
Loop
End Sub
C'est bien utile car utilisable sur n'importe quelle table sans avoir à réécrire une procédure pour chacune d'elles.
Dans les propriétés du formulaire il faut mettre :
Diviseur d'enregistrements sur NON