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

precedent    sommaire    suivant   


Convertir une date au format UNIX en format français
auteur : Team Access

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 Function

Créer un password ou un code (chiffre+lettre) en VBA
auteur : Demco
Pour 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 = provi 

Calculer le résultat d'un tarif à la seconde à partir d'un tarif et d'une heure.
auteur : ARO
Dans 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

 'tu extrait le nb d'heure
 'pour les heures
resultat = Hour(heure) * prix
resultat = resultat + Minute(heure) / 60 * prix

End Sub

Calculer le nombre de jours ouvrables entre 2 dates
auteur : MC2
Il faut mettre bAvecJFerie à False pour ne pas tenir compte des jours ferié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 Paques + 38
  joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Paques + 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 +ieurs 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

Comment connaître le séparateur décimal ?
auteur : Cafeine
Function GiveSep() As String
GiveSep = Mid(3 / 2, 2, 1)
End Function

Transformer des centièmes en minutes, secondes et centièmes
auteur : FRED.G
En 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") 

Comment effectuer un calcul statistique à partir des valeurs contenues dans un tableau ?
auteur : Thierry AIM

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 Sub 

Comment optimiser l'ajout sur une grande table dans un recordset DAO
auteur : Tofalu
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 de 100000 lignes, vous utilisez surement 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 : fr Définition et manipulation de données avec DAO par Tofalu
lien : faq Comment déclarer une référence dans MS-Access ?

Comment faire un Update d'enregistrements non directement modifiables ?
auteur : Philou22

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 Deleter 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 deleter / Add, avec 4 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
 
Sub dt_update(table As String, filtre As String, champ As String, valeur As Variant)
'
' table     : Table lu, deletée et modifiée
' filtre    : condition permettant de sélectionner les enr à 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 2 fois la table :
' une fois au travers d'une requete 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 delete
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
    ' modif champ
    dt2(champ) = valeur
    ' delete 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 chaqu'une d'elle.


Comment enlever le trait de séparation entre la zone en-tête de formulaire et la zone détail de ce meme formulaire ?
auteur : Team Access
Dans les propriétés du formulaire il faut mettre
Diviseur d'enregistrement sur NON

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