Le principe

Utiliser une requête ajout avec laquelle on insert une valeur dans le champ NumAuto.

1. On crée une requête sans sélectionner de table
2. menu requête : requête ajout
3. on selectionne la table que l'on souhaite manipuler
4. sur la ligne - "Champ:" toto: 10000
5. sur la ligne - "Ajouter à :" on selectionne le champ numauto

Cela donne :

INSERT INTO T_LaTable ( NoAuto ) SELECT 1000 AS [toto];

On exécute et il reste à supprimer cet enregistrement et hop !

Dernière modification :02/02/2007 : 03:41  

On peut renseigner une valeur par défaut pour chaque champ d'une table, mais cette valeur n'est que rarement adaptée à la saisie que l'on souhaite réaliser.

Une manière plus souple pour gérer cela est de traiter cela dans le formulaire de saisie.

On utilisera la propriété "defaultvalue" de la zone de texte concernée.

Imaginons que nous avons un champ "Ville" et que nous souhaitions adapter la valeur par défaut au fur et à mesure de notre encodage. Il serait donc pratique que le formulaire nous propose "Paris" comme valeur par défaut... jusqu'à ce que l'on saisisse une autre valeur, qui deviendrait alors automatiquement notre nouvelle valeur par défaut.

Pour obtenir ce fonctionnement, il suffit d'une ligne de code dans l'événement "Après mise à jour" de ladite zone de texte.

Ainsi, lorsque le champ se nomme "Ville", nous aurions alors, par exemple, une zone de texte qui se nomme "txtVille" et l'on devrait obtenir quelque chose comme ceci :

Private Sub txtVille_AfterUpdate()

    Me!txtVille.DefaultValue = """" & txtVille & """"

End Sub

Le fonctionnement est le suivant :

A l'ouverture du formulaire, la zone de texte affichera éventuellement la valeur par défaut fixée dans la table. Ensuite, il suffit de saisir une autre valeur pour que cette nouvelle valeur vous soit automatiquement proposée à l'encodage de l'enregistrement suivant.

Remarquez qu'il y a bien quatre guillemets devant et après la concaténation par le signe "&"

Pour cela il faut utiliser l'Info bulle (ControlTipText)

Dans la Sub de l'événement "Sur activation" du formulaire, il suffit d'alimenter l'info-bulle.

Exemple pour un textbox "Date" :

Me.MaDate.ControlTipText = Format(Me.MaDate, "dddd mmmm yyyy")

Et pourquoi pas aller plus loin :

Me.NomClient.ControlTipText = NomClient & " " & PrenomClient & vbCrLf _
                                                 & AdresseClient & vbCrLf _
                                                 & CodePostal & " - " & VilleClient

A réserver aux formulaires de consultation, bien sûr

Dernière modification :02/02/2007 : 17:07  

Placer ces déclarations dans un module général :

'Déclarations
Public Const HandCursor = 32649&
Public Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" _
          (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long

Ensuite, dans l'événement "Sur souris déplacée" (MouseMove) de l'objet souhaité :

Dim lHandle As Long
lHandle = LoadCursor(0, HandCursor)
If (lHandle > 0) Then SetCursor lHandle

Dernière modification :02/02/2007 : 17:06  

Dernière modification :07/01/2008 : 19:23  

Les boutons des formulaires ont par défaut une apparence grise.

Si l'on remplace le bouton par une étiquette (Label), il est possible d'utiliser une couleur pour le texte comme pour les boutons, mais en plus il est possible d'attribuer un couleur de fond. L'impression de mouvement, l'enfoncement, sera obtenu en ajoutant deux lignes de code.

Par défaut, on donnera l'apparence "en relief" à l'étiquette.

Private Sub Bouton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

End Sub

Private Sub Bouton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

End Sub

Dernière modification :02/02/2007 : 17:08  

Dernière modification :19/04/2007 : 13:54  

Dernière modification :16/05/2007 : 01:49  

Comment lister les indentifiants (clés primaires) des enregistrements sélectionnés dans un formulaire continu.

Code à placer dans la Sub de l'événement "Sur clic" du formulaire.

Private Sub Form_Click()

Dim IDselect() As Variant
Dim lngTop As Long, lngHeight As Long, lngLoop As Long

lngTop = Me.SelTop
lngHeight = Me.SelHeight
ReDim IDselect(lngHeight)

With Me.RecordsetClone

For lngLoop = 1 To lngHeight

Next
End With

'
' La variable tableau IDselect()
' contient maintenant tous les ID
' des enregistrements sélectionnés
'
' Pour exemple, nous affichons les valeurs
' dans la fenêtre d'exécution directe.

For lngLoop = 1 To UBound(IDselect)

Next

End Sub

Dernière modification :07/04/2010 : 12:27  

Dernière modification :26/05/2009 : 03:35  

Dernière modification :24/06/2008 : 22:50  

Dernière modification :31/07/2008 : 02:52  

Note : c'est pour cela que Nz() ne fonctionne pas 

Dernière modification :15/02/2007 : 01:49  

Cette fonction, qui supporte les numéros de comptes alphanumériques, doit être utilisée pour comparer la clé RIB calculée par rapport à la clé RIB saisie, afin de se prémunir contre les erreurs de frappe.

Function fCalculCleRIB(RIB As String) As Integer

Dim Position As Integer
Dim strDigit As String
Dim NumericRIB As String

For Position = 1 To Len(RIB)

strDigit = UCase(Mid(RIB, Position, 1))

If IsNumeric(strDigit) Then
NumericRIB = NumericRIB & strDigit
Else

Select Case Asc(strDigit)

Case Is < 65
NumericRIB = NumericRIB
Case 65 To 73
NumericRIB = NumericRIB & Chr(Asc(strDigit) - 16)
Case 74 To 82
NumericRIB = NumericRIB & Chr(Asc(strDigit) - 25)
Case 83 To 90
NumericRIB = NumericRIB & Chr(Asc(strDigit) - 33)
Case Is > 90
NumericRIB = NumericRIB
End Select

End If

Next Position

If Len(NumericRIB) = 21 Then

End If

End Function

Dernière modification :11/04/2007 : 13:01  

Cette fonction doit être utilisée pour comparer la clé SIREN calculée par rapport à la clé SIREN saisie, afin de se prémunir contre les erreurs de frappe.

Function Cle_Siren(Siren_sur_huit As String) As Byte

Dim Tampon_Siren As String
Dim Position As Byte
Dim Cumul_Siren As Integer

Tampon_Siren = ""
For Position = 1 To 8

Next Position

Cumul_Siren = 0

For Position = 1 To Len(Tampon_Siren)

Next Position

Cle_Siren = Right(10 - Val(Right(Cumul_Siren, 1)), 1)

End Function

Dernière modification :02/02/2007 : 07:10  

Cette fonction doit être utilisée pour comparer la clé SIRET calculée par rapport à la clé SIRET saisie, afin de se prémunir contre les erreurs de frappe.

Function Cle_Siret(Siret_sur_treize As String) As Byte

Dim Tampon_Siret As String
Dim Position As Byte
Dim Cumul_Siret As Integer
Tampon_Siret = ""

For Position = 1 To 13

Tampon_Siret = Tampon_Siret _
+ CStr(Val(Mid(Siret_sur_treize, Position, 1)) _
* IIf((Position Mod 2) = 0, 1, 2))

Next Position

Cumul_Siret = 0

For Position = 1 To Len(Tampon_Siret)

Cumul_Siret = Cumul_Siret + Val(Mid(Tampon_Siret, Position, 1))

Next Position

Cle_Siret = Right(10 - Val(Right(Cumul_Siret, 1)), 1)

End Function

Dernière modification :26/04/2006 : 20:40  

Pour se prémunir des erreurs de frappe, comparer la clé du numéro de sécurité sociale calculée par rapport à la clé saisie.

Function CleSecu(NoSecu As String) As String

CleSecu = Format(97 - 97 * (CDec(NoSecu) / 97 - Int(CDec(NoSecu) / 97)), "00")

End Function

Dernière modification :02/02/2007 : 07:10  

Par VBA, on peut souhaiter afficher ou non la barre d'état.

Cette propriété est accessible via le menu Access "Outils, Options, onglet Affichage.

On utilisera le code suivant ( pour cacher, remplacer "True" par "False") :

Application.SetOption "Show Status Bar", True

ShowWindowsInTaskbar"

- affiche un onglet pour chaque fenêtre dans la barre des tâches

"Auto Compact"

- Compacter la base lors de la fermeture

"Remove Personal Information"

- Supprime les informations personnelles des fichiers lors de l'enregistrement

Remarque :

On peut faire usage de la méthode "GetOption" si l'on souhaite simplement lire l'état ou le contenu d'une option.

Utiliser la fonction StrPtr() qui renvoie l'adresse de la variable

Dim sInput As String
sInput = InputBox("Allons y ... testez-moi", "Demo InputBox")

If StrPtr(sInput) = 0 Then
    MsgBox "Vous avez annulé..."
Else
    If Len(sInput) = 0 Then
        MsgBox "Vous avez appuyé sur OK, mais sans saisie."
    Else
        MsgBox "Vous avez appuyé sur OK, la valeur est : " & sInput
    End If
End If

Dernière modification :02/02/2007 : 07:12  

Dernière modification :02/09/2006 : 15:01  

A placer dans un module général

'Attendre la fin
Public Const SND_SYNC = &H0

'Rend la main immédiatement
Public Const SND_ASYNC = &H1

'Eviter le beep en cas d'erreur
Public Const SND_NODEFAULT = &H2

'Lire en boucle : SND_ASYNC + SND_LOOP
Public Const SND_LOOP = &H8

'Empêcher l'interruption de la lecture
Public Const SND_NOSTOP = &H10

'Arrêt : sndPlaySound vbNullString, SND_PURGE
Public Const SND_PURGE = &H40

Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
         (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Syntaxe : Call sndPlaySound ("C:cheminfichier.wav", SND_ASYNC + SND_NODEFAULT)

Dernière modification :02/02/2007 : 07:13  

Pour modifier le chemin d'accès de vos photos sauvées dans un champ [CheminPhoto] sous la forme "C:Collectionimages.jpg" de votre table "Photos", utilisez la fonction suivante:

Function fnChangePath(sPathOriginal, sNeuPath) As String

Dim iPos As Integer
fnChangePath = sNeuPath & Mid(sPathOriginal, InStrRev(sPathOriginal, ""))

End Function

Usage dans une requête de mise à jour :

Table: Photos

Mise à jour: fnChangePath([CheminPhoto];"C:Mes photos")

Dernière modification :29/05/2007 : 02:14  

Syntaxe : Sleep 5000

qui vous permet d'attendre 5 secondes (5000ms)

Placez ceci dans un module général :

Dernière modification :02/02/2007 : 17:11  

Function fnHeures2Min(H) As Integer
    If IsNull(H) Then
        fnHeures2Min = 0
    Else
        fnHeures2Min = (Hour(H) * 60) + Minute(H)
    End If
End Function

TempsMinutes: fnHeures2Min([Le-champ-heures])

Dernière modification :09/08/2010 : 21:55  

Public Function fnMinutes2Heures(M) As String
    '/Retourne une chaîne en format HH:MM
    Dim iHrs As Integer, iMin As Integer
    
    If Not IsNull(M) Then
        iHrs = M \ 60
        iMin = M Mod 60
        '/Formater en heures et minutes
        fnMinutes2Heures = Format(iHrs, "00") & ":" & Format(iMin, "00")
    End If
End Function

= fnMinutes2Heures([Le-champ-numérique])

HeuresMinutes: fnMinutes2Heures([Le-champ-numérique])

Dernière modification :09/08/2010 : 22:00  

Dernière modification :06/02/2007 : 16:22  

Syntaxe : Dans une zone de texte: = fnAge(DateNaissance)

Syntaxe : Dans une requête: Age: fnAge(DateNaissance)

Function fnAge(DateNaissance As Variant) As Integer

If Not IsDate(DateNaissance) Then Exit Function

fnAge = DateDiff("yyyy", DateNaissance, Date) + (Format(Date, "mmdd") _
< Format(DateNaissance, "mmdd"))

End Function

Dernière modification :30/05/2006 : 00:04  

Syntaxe dans une zone de texte:

= AgeMoisAn(DateNaissance)

Syntaxe dans une requête:

Age: AgeMoisAn(DateNaissance)

Function AgeMoisAns(DateSaisie As Date) As String
    Dim DateRef As Date
    DateRef = Date
    Select Case Month(DateRef) < Month(DateSaisie)
        Case True
            AgeMoisAns = DateDiff("yyyy", DateSaisie, DateRef) - 1 & " ans et " & _
                         12 - (Month(DateSaisie) - Month(DateRef)) & " mois"
        Case False
            AgeMoisAns = DateDiff("yyyy", DateSaisie, DateRef) & " ans et " & _
                         (Month(DateRef) - Month(DateSaisie)) & " mois"
    End Select
End Function

Dernière modification :03/07/2006 : 02:39  

Dernière modification :02/02/2007 : 17:24  

Retourne le dernier jour du mois de la date renseignée

Syntaxe : LastDayMonth(#9/17/2003#)
 

Function LastDayMonth(LaDate As Date) As Date

    LastDayMonth = DateSerial(Year(LaDate), Month(LaDate) + 1, 0)

End Function

Dernière modification :02/02/2007 : 17:26  

Dernière modification :26/04/2006 : 20:44  

Syntaxe : fPremierJourSemaine(14, 2005)

Function fPremierJourSemaine(Semaine As Integer, annee As Integer) As Date

Dim Datetemp As Date

Datetemp = DateSerial(annee, 1, 1) + (Semaine - 1) * 7

fPremierJourSemaine = Datetemp - (Weekday(Datetemp) - vbMonday)

End Function

Dernière modification :02/02/2007 : 03:39  

Syntaxe : FirstDayMonth(#9/17/2003#)

Function FirstDayMonth(LaDate As Date) As Date

FirstDayMonth = DateSerial(Year(LaDate), Month(LaDate), 1)

End Function

Dernière modification :02/02/2007 : 03:40  

L'appel de la fonction ci-dessous pourrait se faire par :

Utilisation :

Dim iAnnee As Integer
iAnnee = 2006

If EstBissextile(iAnnee) Then

Else

End If

Function EstBissextile(ByVal UneAnnee As Integer) As Boolean

End Function

Dernière modification :24/04/2007 : 05:42  

Dernière modification :23/02/2007 : 19:24  

Lorsque dans la table, existe un champ qui contient le chemin et le nom d'un fichier, il est facile de démarrer le programme par défaut attribué à son extension.

Devant votre zone de texte, placez une étiquette indépendante. Eventuellement, couper et coller l'étiquette existante ce qui aura pour effet de la rendre indépendante.

Private Sub Form_Current()

'// Préparation de l'étiquette
If IsNull(Me.NomImage.Value) Then

Else

End If

End Sub

Private Sub lbl_NomImage_Click()
'//
'// Sur clic de l'étiquette
'//

If Not IsNull(Me.NomImage) Then

Me.lbl_NomImage.HyperlinkAddress = "file:" & Me.NomImage.Value
Me.lbl_NomImage.Hyperlink.Follow
Me.lbl_NomImage.HyperlinkAddress = ""

End If

End Sub

Dernière modification :02/02/2007 : 18:17  

Cocher la référence 'Microsoft Scripting Runtime'

Function ReadHDSerial(Optional strHD As String = "C:") As Long
    On Error GoTo read_error
    Dim fso As New Scripting.FileSystemObject
    ReadHDSerial = Abs(fso.Drives(strHD).SerialNumber)
        
read_exit:
    Exit Function
    
read_error:
    ReadHDSerial = 0
    Resume read_exit
End Function

Dernière modification :12/08/2006 : 05:03  

Function FindMesDocuments()

Dim Wsh As Object
Dim WshSystem As Object

Set Wsh = CreateObject("WScript.Shell")
Set WshSystem = Wsh.Environment("SYSTEM")

FindMesDocuments = Wsh.SpecialFolders("MyDocuments")

Set WshSystem = Nothing
Set Wsh = Nothing

End Function

Dernière modification :18/01/2007 : 19:23  

Public Declare Function GetSystemDirectory Lib "kernel32" _
           Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Const MAX_PATH = 260

Function GetSysPath() As String

Dim buff As String
Dim ret As Long
buff = Space$­­­­­(MAX_PATH)
ret = GetSystemDirectory(buff, MAX_PATH)
GetSysPath = Left$­­­­­(buff, ret) & ""

End Function

Dernière modification :02/02/2007 : 18:18  

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
                        (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Function tempPath() As String

Dim strTemp As String
strTemp = String(255, Chr$­­­­(0))
GetTempPath 255, strTemp
tempPath = Left$­­­­(strTemp, InStr(strTemp, Chr$­­­­(0)) - 1)

End Function

Dernière modification :02/02/2007 : 18:19  

La version runtime d'Access se détecte par la commande suivante qui renvoie 'True'

Debug.Print SysCmd(acSysCmdRuntime)

que l'on pourra utiliser de la manière suivante :

if SysCmd(acSysCmdRuntime) = True Then

else

end if

Dernière modification :02/02/2007 : 18:20  

Utilisez la fonction "SysCmd(715)"

En combinaison avec la constante "acSysCmdAccessVer" vous obtenez la version d'Access

SysCmd(acSysCmdAccessVer) = 9 -> Access 2000
SysCmd(715) = 2719 ' Access 2000 sans SP
SysCmd(715) = 3822 ' Access 2000 SP1
SysCmd(715) = 4506 ' Access 2000 SP2
SysCmd(715) = 6620 ' Access 2000 SP3

SysCmd(acSysCmdAccessVer) = 10 -> Access 2002
SysCmd(715) = 2627 ' Access 2002(XP) sans SP
SysCmd(715) = 3409 ' Access 2002(XP) SP1
SysCmd(715) = 4302 ' Access 2002(XP) SP2
SysCmd(715) = 6501 ' Access 2002(XP) SP3

SysCmd(acSysCmdAccessVer) = 11 -> Access 2003
SysCmd(715) = 5614 ' Access 2003 sans SP
SysCmd(715) = 6355 ' Access 2003 SP1
SysCmd(715) = 6566 ' Access 2003 SP2

Dernière modification :26/04/2006 : 20:37  

Dernière modification :26/04/2006 : 20:37