Les mémos

Fermer Tables

Fermer Requêtes

Fermer Formulaires

Fermer Etats

Fermer Modules

Fermer Base

Fermer Automation

Fermer Administration

Fermer Registre

Fermer String

Fermer Email CDO

Fermer Outlook

Fermer Net

Fermer Dates - Heures

Fermer Fichiers

Fermer Références

Fermer Vrac

Je débute...

Fermer La normalisation

Fermer VBA

Attention
Aucun support
par émail !

Utilisez le forum pour les questions/réponses concernant MsAccess et les codes que vous trouverez sur ce site.
Visites

   visiteurs

   visiteurs en ligne

FAQ

Fermer  Table

On serait tenté d'utiliser "ALTER TABLE..." ce qui ne fonctionne pas. Sauf à ajouter un nouveau champ, éventuellement transférer les données et supprimer l'ancien champ.

On peut par contre le faire ainsi :

CurrentDB.TableDefs("LaTable").Fields("AncienNomDuChamp").Name = "NouveauNom"


Date de création :01/12/2006 : 02:40Dernière modification :01/12/2006 : 02:40Imprimer l'article  Hyperlien

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 !


Date de création :26/04/2006 : 19:13Dernière modification :02/02/2007 : 03:41Imprimer l'article  Hyperlien

Fermer  Formulaire

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 "&"

 


Date de création :22/03/2012 : 03:28Dernière modification :22/03/2012 : 03:28Imprimer l'article  Hyperlien

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 wink



Date de création :25/02/2006 : 17:12Dernière modification :02/02/2007 : 17:07Imprimer l'article  Hyperlien

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


Date de création :12/02/2006 : 13:33Dernière modification :02/02/2007 : 17:06Imprimer l'article  Hyperlien

A partir d'un formulaire possédant un textbox ayant comme source un champ OLE, on peut l'alimenter de la façon suivante :


' FichierOLE est le champ OLE


With Me.FichierOLE

.Class = "Word.Document"
.OLETypeAllowed = acOLELinked
.SourceDoc = "H:\TestDoc.doc"
.Action = acOLECreateLink

'Affichage du document si souhaité
.Action = acOLEActivate

End With


Date de création :16/02/2007 : 18:41Dernière modification :07/01/2008 : 19:23Imprimer l'article  Hyperlien

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)

Me.Bouton.SpecialEffect = 2

End Sub


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

Me.Bouton.SpecialEffect = 1

End Sub


Date de création :25/04/2006 : 18:31Dernière modification :02/02/2007 : 17:08Imprimer l'article  Hyperlien

Un objet quelconque (zone de texte, section de formulaire...) dont on souhaite changer la couleur en cycle.

Ici, c'est le fond d'une zone de texte "Horloge".


'Déclaration - au dessus de la première Sub !

Dim iCol As Integer
Const Col1 As Long = 65280
Const Col2 As Long = 8454143
Const Col3 As Long = 16711680

Private Sub Form_Timer()
iCol = iCol + 1
Select Case iCol
Case 1: Me.Horloge.BackColor = Col1
Case 2: Me.Horloge.BackColor = Col2
Case 3: Me.Horloge.BackColor = Col3: iCol = 0
End Select
End Sub


Date de création :24/02/2007 : 04:31Dernière modification :19/04/2007 : 13:54Imprimer l'article  Hyperlien

Pour exécuter du code lors de la sélection d'un onglet appartenant à un contrôle onglet, il faut utiliser l'événement "Sur changement" (Change) de ce contrôle à onglet.

Pour sélectionner ce contrôle, cliquez sur la bande grise à coté de l'onglet le plus à droite. Alternativement, on peut cliquer sur le contour (le cadre) de cette boite, mais pas sur un onglet. Ensuite appelez les propriétés, puis l'onglet événement.


Private Sub CtlTab0_Change()

Select Case CtlTab0.Value
Case 0 'onglet 0
'code
Case 1 'onglet 1
'code
Case 2 'onglet 2
'code
End Select

End Sub


Il est à remarquer que les onglets sont numérotés de 0 (zéro) à n.


Date de création :16/05/2007 : 00:53Dernière modification :16/05/2007 : 01:49Imprimer l'article  Hyperlien

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

.AbsolutePosition = lngTop - 1

For lngLoop = 1 To lngHeight

IDselect(lngLoop) = .Fields(0)
'
' .Fields(0)
' contient la valeur du premier champ
' qui est normalement la clé primaire
'
.MoveNext

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)

Debug.Print IDselect(lngLoop)

Next

End Sub


Une base exemple est disponible dans la zone téléchargement.

Date de création :22/03/2006 : 02:09Dernière modification :07/04/2010 : 12:27Imprimer l'article  Hyperlien

Si l'on souhaite jouer un son à l'ouverture d'un formulaire ou sur tout autre événement, on placera le code ci-dessous dans un module général.


Option Compare Database
Option Explicit

'// Dans un module standard.
Public Declare Function PlaySound Lib "winmm.dll" _
                                  Alias "PlaySoundA" _
                                  (ByVal lpszName As String, _
                                   ByVal hModule As Long, _
                                   ByVal dwFlags As Long) As Long

Public Const SND_ASYNC = &H1          '  joue en asynchrone.
Public Const SND_FILENAME = &H20000   '  indique nom de fichier.


Puis, dans l'événement "Sur chargement" du formulaire on écrit :


// Dans un formulaire.
Private Sub Form_Load()
     PlaySound "C:MonDossierMonFichierSon.wav", ByVal 0&, _
                           SND_FILENAME Or SND_ASYNC
End Sub


Date de création :26/05/2009 : 03:31Dernière modification :26/05/2009 : 03:35Imprimer l'article  Hyperlien

Il peut être fastidieux de cadrer correctement la taille d'un formulaire.

Pour ne pas passer par des phases de positionnement de la fenêtre - sauvegarde - ouverture - pour tenter d'obtenir "le cadrage parfait", il est bien plus simple d'ajouter un simple instruction dans la sub de l'événement "Sur chargement".


Private Sub Form_Open(Cancel As Integer)

DoCmd.RunCommand acCmdSizeToFitForm

End Sub



Date de création :01/06/2007 : 14:16Dernière modification :24/06/2008 : 22:50Imprimer l'article  Hyperlien

Fermer  Requête

Lorsqu'une requête possède un critère qui pointe une liste déroulante sur un formulaire, il peut être souhaitable que la requête ramène tous les enregistrements lorsqu'il n'y a pas de valeur sélectionnée dans la liste.

Considérons un formulaire "frmClients" et une liste "lstCodeClient".


Le critère simple aura donc cette forme:

Forms!frmClients!lstCodeClient

Pour obtenir tous les clients lorsque la liste est sans sélection (vide):

Forms!frmClients!lstCodeClient OR Forms!frmClients!lstCodeClient Is Null


Date de création :31/07/2008 : 02:42Dernière modification :31/07/2008 : 02:52Imprimer l'article  Hyperlien

Fermer  Les états

Dans le pied du sous-état (sfFacture), une zone de texte txtSumPrix affiche la somme de la zone de texte txtPrix qui se trouve dans la section détail.

Comme on le sait, cela s'obtient en donnant comme source =Sum(txtPrix)

Lorsque pour une raison quelconque, il ny a pas de ligne de détail, le sous-formulaire est vide et la zone de texte txtSumPrix dans laquelle est faite la somme n'est pas adressable (n'existe pas...)

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


Pour éviter l'erreur se produisant lors d'un sous-état vide, on utilise l'expression suivante dans l'état principal :

= IIF(IsError(sfFacture.Report!txtSumPrix) ; 0 ; sfFacture.Report!txtSumPrix)


Date de création :15/02/2007 : 01:35Dernière modification :15/02/2007 : 01:49Imprimer l'article  Hyperlien

Fermer  Comment trouver...

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

fCalculCleRIB = 97 * (Int((CDec(NumericRIB) * 100) / 97) + 1) - (CDec(NumericRIB) * 100)

End If

End Function


Date de création :02/11/2005 : 00:49Dernière modification :11/04/2007 : 13:01Imprimer l'article  Hyperlien

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

Tampon_Siren = Tampon_Siren + CStr(Val(Mid(Siren_sur_huit, Position, 1)) * IIf((Position Mod 2) = 0, 2, 1))

Next Position

Cumul_Siren = 0

For Position = 1 To Len(Tampon_Siren)

Cumul_Siren = Cumul_Siren + Val(Mid(Tampon_Siren, Position, 1))

Next Position

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

End Function


Date de création :02/11/2005 : 00:53Dernière modification :02/02/2007 : 07:10Imprimer l'article  Hyperlien

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


Date de création :02/11/2005 : 00:55Dernière modification :26/04/2006 : 20:40Imprimer l'article  Hyperlien

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



Date de création :02/11/2005 : 01:00Dernière modification :02/02/2007 : 07:10Imprimer l'article  Hyperlien

Fermer  Comment faire...

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

Quelques autres options :

"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.


Date de création :21/01/2008 : 18:56Dernière modification :21/01/2008 : 18:56Imprimer l'article  Hyperlien

Pour faire la conversion des couleurs RGB vers les valeurs numériques de Access, on peut utiliser la petite fonction suivante :


Function RGB2Acolor(r As Long, g As Long, b As Long) As Long
  '//
  '// Transpose les couleurs RGB en valeur numérique "Access"
  '//
 
  RGB2Acolor = r + (g * 256) + (b * 256 * 256)

End Function




Date de création :19/01/2007 : 12:18Dernière modification :19/01/2007 : 12:18Imprimer l'article  Hyperlien

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


Date de création :03/11/2005 : 12:41Dernière modification :02/02/2007 : 07:12Imprimer l'article  Hyperlien

Un petit utilitaire léger et sans installation pour faire de petites modifications à une base de données Access.

Vous pouvez télécharger MDBPlus dans la zone de téléchargement , sous la rubrique "Divers" ou sur le site de l'auteur.



Date de création :02/09/2006 : 14:44Dernière modification :02/09/2006 : 15:01Imprimer l'article  Hyperlien

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)


Date de création :02/11/2005 : 01:09Dernière modification :02/02/2007 : 07:13Imprimer l'article  Hyperlien

Pour modifier le chemin d'accès de vos photos sauvées dans un champ [CheminPhoto] sous la forme "C:\Collection\images.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 :

Champ: [CheminPhoto]

Table: Photos

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




Date de création :17/03/2006 : 16:04Dernière modification :29/05/2007 : 02:14Imprimer l'article  Hyperlien

Syntaxe : Sleep 5000


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



Placez ceci dans un module général :

Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliseconds As Long)


Date de création :01/11/2005 : 23:45Dernière modification :02/02/2007 : 17:11Imprimer l'article  Hyperlien

Fermer  Problèmes de Date

Access ne connait pas la notion de durée, mais uniquement des dates et heures.

Pour additionner ces "heures", il faut donc les convertir en valeur numérique.

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


Dans une requête, on créera donc un champ calculé:

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

Date de création :09/08/2010 : 19:05Dernière modification :09/08/2010 : 21:55Imprimer l'article  Hyperlien

Fonction pour formater une valeur numérique au format Heures/Minutes

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


Dans un formulaire on écrira directement dans une zone de texte indépendante:


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


Dans une requête, on utilisera le champ calculé:

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

Date de création :09/08/2010 : 19:16Dernière modification :09/08/2010 : 22:00Imprimer l'article  Hyperlien

En dehors de l'interface qui utilise le format défini dans les paramètres régionaux, il faut toujours présenter les date au format US. Une petite fonction facilitera cette manipulation.

Code :
Public Function DateUS(UneDate) As String
Dim d As Date
If IsDate(UneDate) Then
d = CDate(UneDate)
DateUS = Format(UneDate, "\#mm/dd/yyyy\#")
Else
DateUS = ""
End If
End Function

Date de création :01/10/2010 : 04:21Dernière modification :01/10/2010 : 04:21Imprimer l'article  Hyperlien

Pour trouver la date du jour dont on fourni le numéro du jour et le mois, on peut utiliser la fonction ci-dessous.

On fournira le numéro du mois (1 à 12) et le numéro du jour (1 = lundi, 2 = mardi, etc.)

Public Function FirstInMonth(iMonth As Integer, iDayNumber As Integer) As Date
'/ Retourne la date du premier jour selon le numéro du mois
'/ et le numéro du jour fourni de l'année courante
'/
'/ X = FirstInMonth( 11, 2)
'/ renvoie le 5/11/2013

Dim DayOfWeek As Date, iD As Integer
Dim DayNo As Integer, MonthNo As Integer, YearNo As Integer

DayNo = 1
MonthNo = iMonth
YearNo = Year(Date)

For iD = 1 To 8
   DayOfWeek = DateSerial(YearNo, MonthNo, iD)
   If WeekDay(DayOfWeek, vbMonday) = iDayNumber Then
      FirstInMonth = DayOfWeek
      Exit For
   End If
Next iD
End Function

Date de création :17/03/2013 : 21:06Dernière modification :17/03/2013 : 21:06Imprimer l'article  Hyperlien

Dans un état, il peut être nécessaire d'écrire une date en texte à l'anglaise.

A la fonction suivante, on transmettra simplement le date à convertir : USDate([ChampDate])


Function USdate(xDate) As String
Dim sM As String

If IsNull(xDate) Or Not IsDate(xDate) Then
USdate = ""
Else
sM = Choose(Month(xDate), "January", "February", "March", _
"April", "May", "June", "July", _
"August", "September", "October", _
"November", "December")

USdate = sM & " " & Day(xDate) & ", " & Year(xDate)

End If
End Function


Date de création :06/02/2007 : 16:14Dernière modification :06/02/2007 : 16:22Imprimer l'article  Hyperlien

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

 

 


Date de création :01/11/2005 : 23:41Dernière modification :30/05/2006 : 00:04Imprimer l'article  Hyperlien

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

 


Date de création :07/12/2005 : 17:45Dernière modification :03/07/2006 : 02:39Imprimer l'article  Hyperlien

A l'aide de la fonction DateSerial(a, m, j) qui demande dans l'ordre un nombre pour l'année, le mois et le jour, on renseigne le 1er janvier de l'année en cours.

Pour obtenir la veille du 1er janvier, il suffit donc de "retirer 1" au chiffre qui représente le jour.


Dans un requête ou une zone de texte :
= DateSerial(Year(Date());1;0)


Dans le code VBA :
= DateSerial(Year(Date),1,0)


Le premier jour de l'année en cours aurait été donné par :
= DateSeriel(Year(Date),1,1)


Date de création :02/11/2005 : 02:55Dernière modification :02/02/2007 : 17:24Imprimer l'article  Hyperlien

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


Date de création :01/11/2005 : 23:32Dernière modification :02/02/2007 : 17:26Imprimer l'article  Hyperlien

A l'aide de la fonction "DateSerial(y,m,d)" on renseigne l'année, le mois et le 1er jour du mois auquel on retire 1.

= DateSerial(Year(Date());Month(Date());0)

Date de création :02/11/2005 : 03:19Dernière modification :26/04/2006 : 20:44Imprimer l'article  Hyperlien

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


Date de création :01/11/2005 : 22:49Dernière modification :02/02/2007 : 03:39Imprimer l'article  Hyperlien

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


Function FirstDayMonth(LaDate As Date) As Date

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

End Function


Date de création :01/11/2005 : 22:58Dernière modification :02/02/2007 : 03:40Imprimer l'article  Hyperlien

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


Utilisation :

Dim iAnnee As Integer
iAnnee = 2006

If EstBissextile(iAnnee) Then

MsgBox "L'année " & iAnnee & " est bissextile"

Else

MsgBox "L'année " & iAnnee & " n'est pas bissextile"

End If


Function EstBissextile(ByVal UneAnnee As Integer) As Boolean

EstBissextile = (UneAnnee Mod 4 = 0 _
                         And (UneAnnee Mod 100 <> 0 Or UneAnnee Mod 400 = 0))

End Function


Date de création :17/01/2006 : 01:45Dernière modification :24/04/2007 : 05:42Imprimer l'article  Hyperlien

Fermer  Système

Installez le petit soft DevEject.exe (voir téléchargement, section Divers) dans le répertoire Windows.

Pour déconnecter une clé USB qui porte la lettre "M:", il vous reste à l'appeler via la commande Shell()

Call Shell("DevEject.exe -EjectDrive:M:")


Date de création :23/02/2007 : 18:59Dernière modification :23/02/2007 : 19:24Imprimer l'article  Hyperlien

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

Me.lbl_NomImage.Caption = "Pas d'image"
Me.lbl_NomImage.FontUnderline = False
Me.lbl_NomImage.ForeColor = vbBlack

Else

Me.lbl_NomImage.Caption = Me.NomImage.Value
Me.lbl_NomImage.FontUnderline = True
Me.lbl_NomImage.ForeColor = vbBlue

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



Date de création :28/02/2006 : 17:08Dernière modification :02/02/2007 : 18:17Imprimer l'article  Hyperlien

Appelez la fonction "TestRuntime" qui fermera votre application si elle n'est pas ouverte par le runtime.


Function TestRuntime() As Integer
If SysCmd(acSysCmdRuntime) = 0 Then
'Pas le runtime
Application.Quit
End If
End Function


Date de création :23/02/2007 : 15:56Dernière modification :23/02/2007 : 15:56Imprimer l'article  Hyperlien

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


Function ReadHDSerial(strHD As String) As Long

        Dim fso As New Scripting.FileSystemObject

        ReadHDSerial = fso.Drives(strHD).SerialNumber

End Function


Date de création :12/08/2006 : 05:02Dernière modification :12/08/2006 : 05:03Imprimer l'article  Hyperlien

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


Date de création :02/11/2005 : 00:02Dernière modification :18/01/2007 : 19:23Imprimer l'article  Hyperlien

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


Date de création :02/11/2005 : 00:07Dernière modification :02/02/2007 : 18:18Imprimer l'article  Hyperlien

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


Date de création :02/11/2005 : 00:06Dernière modification :02/02/2007 : 18:19Imprimer l'article  Hyperlien

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

' runtime

else

' pas runtime

end if


Date de création :14/12/2005 : 14:50Dernière modification :02/02/2007 : 18:20Imprimer l'article  Hyperlien

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


Date de création :03/11/2005 : 03:21Dernière modification :26/04/2006 : 20:37Imprimer l'article  Hyperlien

Tapez dans le fenêtre d'exécution directe :

Debug.Print SysCmd(acSysCmdAccessDir)

Date de création :03/11/2005 : 03:52Dernière modification :26/04/2006 : 20:37Imprimer l'article  Hyperlien

Recherche



Lettre d'information
Pour avoir des nouvelles de ce site, inscrivez-vous à notre Newsletter.
Captcha
Recopier le code :
Au sujet de l'auteur
L'auteur qui fréquente (fréquentait) le forum microsoft.public.fr.access a eu le plaisir d'être nommé MVP Office-Access de janvier 2003 à décembre 2011.

Qui sont les MVP ?

Divers ;-)
Nous contacter

Haut