FAQ MS-AccessConsultez toutes les FAQ

Nombre d'auteurs : 140, nombre de questions : 926, dernière mise à jour : 30 mars 2017 

 
OuvrirSommaireVBAManipulation des donnéesManipulation des données Trucs et Astuces


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.

 
Sélectionnez

Function convertDateUnix(lngDate As Long)
convertDateUnix = DateAdd("s", lngDate, #1/1/1970#)
End Function
Mis à jour le 29 août 2006  par Team Access

Pour le nombre aléatoire :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 = provi 
Créé le 25 octobre 2004  par Demco

Dans cet exemple, il s'agit d'un tarif à la seconde :

 
Sélectionnez
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 Sub
Créé le 25 octobre 2004  par ARO

Il faut mettre bAvecJFerie à False pour ne pas tenir compte des jours fériés, rien sinon.

 
Sélectionnez
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 Function

Attention : cet article prend en compte le lundi de Pentecôte qui n'est à ce jour plus férié.

Mis à jour le 4 décembre 2004  par MC2
 
Sélectionnez
Function GiveSep() As String
GiveSep = Mid(3 / 2, 2, 1)
End Function
Créé le 6 octobre 2003  par cafeine

En VBA :

 
Sélectionnez
Format(Int(Resultat \ 6000), "00") & ":" & Format(Int((Resultat Mod 6000) \ 100), "00") & ":" & Format(Int((Resultat Mod 6000) Mod 100), "00") 

En Access :

 
Sélectionnez
Format(Ent(Resultat \ 6000); "00") & ":" & Format(Ent((Resultat Mod 6000) \ 100); "00") & ":" & Format(Ent((Resultat Mod 6000) Mod 100); "00") 
Créé le 10 mai 2005  par FRED.G
 
Sélectionnez

Voici par exemple une fonction pour calculer un écart type sur les valeurs contenues dans un tableau :
 
Sélectionnez

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.

 
Sélectionnez

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 Sub 
Créé le 20 novembre 2005  par ThierryAIM

Pour 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 :

 
Sélectionnez

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 :

 
Sélectionnez

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.

 
Sélectionnez

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.

Créé le 29 novembre 2006  par Tofalu

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.

La procédure ci-dessous traite n'importe quelle table DAO où on peut supprimer/ajouter, avec quatre paramètres :
  • - nom de la table ;
  • - condition donnant la portée des modifications ;
  • - nom du champ dont le contenu est à modifier ;
  • - nouvelle valeur du champ.
 
Sélectionnez
 
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.

Créé le 14 octobre 2007  par philou22

Dans les propriétés du formulaire il faut mettre :

 
Sélectionnez
Diviseur d'enregistrements sur NON
Créé le 14 octobre 2007  par Team Access
  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2013 Developpez Developpez LLC. Tous 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'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.