| | 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
|
|
| | auteur : Demco | Pour le nombre aléatoire :
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
For i = 0 To 9
mdp = DLookup("caractere", "password", "id = " & Int(Rnd * 36 + 1))
provi = provi & mdp
Next i
pass = provi
|
|
| | 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
resultat = Hour(heure) * prix
resultat = resultat + Minute(heure) / 60 * prix
End Sub
|
|
| | 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
joursFeries(11) = joursFeries(9) + 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
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
fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
End Function
|
|
| | auteur : Cafeine | Function GiveSep() As String
GiveSep = Mid(3 / 2, 2, 1)
End Function
|
|
| | 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")
|
|
| | 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))
Var2 = Var2 + tbl(i)
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)
For i = 1 To 10
table(i) = i
Next
Debug.Print EcartTypeP(table)
End Sub
|
|
| | 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 :  Définition et manipulation de données avec DAO par Tofalu
lien :  Comment déclarer une référence dans MS-Access ?
|
| | 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)
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)
Set dt = db.OpenRecordset(instsql, DB_OPEN_DYNASET)
Set dt2 = db.OpenRecordset(table, DB_OPEN_DYNASET)
dt.MoveFirst
Do Until dt.EOF
dt2.AddNew
For i = 0 To dt.Fields.Count - 1
dt2(i) = dt(i)
Next i
dt2(champ) = valeur
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.
|
| | auteur : Team Access | Dans les propriétés du formulaire il faut mettre Diviseur d'enregistrement sur NON
|
|
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.
|
