If MsgBox("Valider la mise a jour ?? ", vbOKCancel) = vbCancel Then
            MsgBox "L\'opération de mise a jour a été annulée", vbInformation
            Cancel = true ' annule l'opération
            Exit Sub
        And If

Option Compare Database
Option Explicit
Private AModifier As Boolean


Private Sub Commande0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If AModifier Then
        AModifier = False
        Commande1.Visible = Not Commande1.Visible
    Else
        'rien à faire
    End If
End Sub

Private Sub Détail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    AModifier = True
End Sub

If AModifier Then

 AModifier = False

Commande1.Visible = Not Commande1.Visible

 Else
        'rien à faire
    End If

Private Sub Détail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    AModifier = True
End Sub

Private AModifier As Boolean

Private Type Position
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 ' --Pour obtenir les coordonnées de la fenêtre parent
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
 ' --Pour obtenir les coordonnées de notre formulaire
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
lpRect As Position) As Long
 ' --Pour obtenir les coordonnées de l'écran
Public Declare Function GetDesktopWindow Lib "user32" () As Long
 ' --Pour positionner et dimensionner la fenêtre
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Private Sub Centrer_Click()
Call Positionner(Me)
End Sub

Public Sub Positionner(frm As Form)
Dim FParent As Position '--Fenêtre Parent
Dim Fenetre As Position
Dim Largeur As Integer
Dim Hauteur As Integer
Dim LParent As Integer ' --Largeur Fenêtre Parent
Dim HParent As Integer ' --Hauteur Fenêtre Parent
Dim PParent As Long ' --Posion parent
On Error GoTo Erreur
 ' --Trouver les coordonnées de mon formulaire à centrer.
PParent = GetParent(frm.hwnd)
 ' --Obtenir les coordonnées de mon formulaire et celles de son parent.
Call GetWindowRect(frm.hwnd, Fenetre)
 ' --Si le parent est la fenêtre Access, pas de soustracion
If PParent <> Application.hWndAccessApp Then
    Call GetWindowRect(PParent, FParent)
Else
    ' -- les coordonnées du Desktop
    Call GetWindowRect(GetDesktopWindow(), FParent)
End If
 ' --Calcul de la largeur et de la hauteur du parent
With FParent
    LParent = .Right - .Left
    HParent = .Bottom - .Top
End With
 ' --Calcul de la largeur et de la hauteur de mon formulaire
With Fenetre
    Largeur = .Right - .Left
    Hauteur = .Bottom - .Top
    .Left = (LParent - Largeur) \ 2
    .Top = (HParent - Hauteur) \ 2
End With
 ' --Centrer mon formulaire
Call MoveWindow(frm.hwnd, Fenetre.Left, Fenetre.Top, Largeur, Hauteur, bRepaint:=True)
Exit Sub
Erreur:
MsgBox "Erreur: " & Err.Number & vbCrLf & Err.Description
End Sub

Function ExistControl(ByVal frm As Form, ByVal ctlName As String) As Boolean
 'frm contient le nom du formulaire, ctlName contient le nom du formulaire
    On Error Resume Next
    If IsError(frm.Controls(ctlName).Tag) Then
        Err.Clear
        Exit Function
    Else
        ExistControl = True
    End If
End Function

Private sub Form_Timer()
lblInfos.Caption = Mid(lblInfos.Caption, 2) & Left(lblInfos.Caption, 1)
End Sub

sql ="SELECT T.CHAMP1, T.CHAMP2, T.CHAMP5 FROM T"

Public Function create_form(sql As String) As Boolean
Dim frm As Form
Dim rst As Recordset
dim ctl as control
dim i, j as integer
 ' --Ouvrir le formulaire en mode modification et caché
DoCmd.OpenForm "F_AFFICHAGE", acDesign
, , , , acHidden
 ' --suppression de tous les contrôles avant de les créer de nouveau
For Each ctl In Forms!F_AFFICHAGE.Controls
        DeleteControl "F_AFFICHAGE", ctl.Name
Next ctl
 ' --Source de données de mon formulaire
Forms![F_AFFICHAGE].RecordSource = sql
Set rst = Currentdb.OpenRecordset(sql)  
 ' --nous ne pensons pas que vous aurez plus de 100 contrôles
Dim controle(1 To 100) As Control
 ' --Création des contrôles
If rst.RecordCount <> 0 Then
    i = 1
    j = 1000
    While i < rst.Fields.Count
    ' -- Créer le contrôle i
    Set controle(i) = CreateControl("F_AFFICHAGE", acTextBox)
    ' --lui affecter un nom
    controle(i).Name = "TXT_" & rst.Fields(i).Name
    ' --le positionner sur le formulaire
    controle(i).Left = 100 + j
    ' --Définir sa largeur
    controle(i).Width = 1150
    ' --Définir sa couleur de fond
    controle(i).BackColor = "14742270"
    ' --Définir son effet visuel
    controle(i).SpecialEffect = 0
    controle(i).BackStyle = 0
    controle(i).BorderStyle = 1
    ' --source de données de ce contrôle
    controle(i).ControlSource = rst.Fields(i).Name
    i = i + 1
    j = j + 1150
    Wend
End If
 ' --Création des entêtes
j = 1000
i = 1
While i < rst.Fields.Count
        Set controle(i) = CreateControl("F_AFFICHAGE", acTextBox, acHeader)
        controle(i).Name = "HD_" & rst.Fields(i).Name
        controle(i).Left = 100 + j
        controle(i).Width = 1150
        controle(i).Height = 700
        controle(i).BackColor = "10081789"
        controle(i).SpecialEffect = 0
        controle(i).BorderStyle = 1
        controle(i).TextAlign = 2
        controle(i).FontWeight = 700
        controle(i).ControlSource = "=\'" & rst.Fields(i).Name & "\'"
        i = i + 1
        j = j + 1150
Wend
rst.close
set rst = Nothing
 ' --Sauvegarder le formulaire
DoCmd.Save acForm, "F_AFFICHAGE"
End Function

Private Sub Form_DblClick(Cancel As Integer)
 ' Crée un enregistrement et insère un compteur dans le champ Ordre.

Dim Compteur As Integer

Application.Echo False
   
Compteur = Me![Ordre]
DoCmd.GoToRecord , , acNewRec
Me![Ordre].Value = Compteur + 1
Me.Requery
Numerotation_Click

Application.Echo True

End Sub

Private Sub Numerotation_Click()
 ' Renumérote les enregistrements.

Dim rcs As DAO.Recordset
Dim i As Integer

Set rcs = Me.RecordsetClone
i = 1
rcs.MoveFirst
While Not rcs.EOF
rcs.Edit
rcs!Ordre = i
rcs.Update
rcs.MoveNext
i = i + 2
Wend

rcs.Close
Set rcs = Nothing

Me.Requery

End Sub

Private Sub Form_Current()

Me.NomDuSousFormulaire.Form.OrderBy = " Ordre"
Me.NomDuSousFormulaire.Form.OrderByOn = True

End Sub

SendKeys "{F2}" 

If IsNull(Me.MonControleObligatoire.oldvalue) Then
  ' on est en ajout
Else
  ' on est en modif
End If

Private sub MonTXT_Click()
MonTXT.Selstart=0
End sub

Private sub MonTXT_Click()
MonTXT.SelStart=0
MonTXT.SelLength=Len(MonTXT)
End sub

Private Type rect

  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type 

Private Declare Function GetWindowRect Lib "User32" _
(ByVal hwnd As Long, lpRect As RECT) As Long

Private Sub Position_Click()
Dim Position As rect
Call GetWindowRect(Me.hwnd, Position)
With Position
MsgBox "Position de mon formulaire" & vbCrLf & "Gauche:" & .Left & vbCrLf _
    & "Droite:" & .Right & vbCrLf & "Inférieur:" & .Bottom & vbCrLf & "Supérieur:" & .Top
End With
End Sub

DoCmd.MoveSize 2440, 2400, , 4000

Function InputBoxNumeric(ByVal PromptZ As String,  _
               ByVal TitleZ As String, ByVal DefaultZ As String) As Double
 'PromptZ : texte dans la Input Box
 'TitleZ : titre à donner à l'InputBox
 'DefaultZ : Valeur par défaut
Dim rep As String

  Start01:
  rep = InputBox(PromptZ, TitleZ, DefaultZ)
  If Len(rep) > 0 Then
    If IsNumeric(rep) Then
      InputBoxNumeric = CDbl(rep)
      Exit Function
    Else
      MsgBox "une valeur numérique est attendue, merci de refaire la saisie"
      GoTo Start01
    End If
  Else
    MsgBox "une valeur numérique est attendue, merci de refaire la saisie"
    GoTo Star1
  End If
End Function

Me.MonSousFormulaire.Visible = (Me.MonSousFormulaire.Form.RecordsetClone.RecordCount > 0)

Me.navigationbuttons = False

Private Sub Texte1_Enter()
Texte1.FontSize = 18
End Sub

Private Sub Texte1_Exit(Cancel As Integer)
Texte1.FontSize = 8
End Sub

DoCmd.OpenForm nomformulaire, , , , , , Me.Name

Select Case OpenArgs
    Case "frmX"
   'ici ce que vous voulez :
      MsgBbox "frmX=" & openArgs
    Case "frmY" :
      'ici ce que vous voulez :
      MsgBox "frmY=" & openArgs     
End Select

Private Sub RefreshQuery()
Dim SQL As String
Dim SQLWhere As String
...

End Sub

Dim SQL As String

Private Sub RefreshQuery()
Dim SQLWhere As String
...

End Sub

Private Sub btnCréerRequête_Click()

'****************************
'Faculatif si la variable SQL mise à jour dans Sub RefreshQuery est de niveau module :
'Dim SQL As String
'SQL = Me!lstResults.RowSource
'****************************

Dim NomQDF as String
'Faites ici tous vos tests pour vous assurer d'un nom valide pour la requête à créer :
NomQDF = InputBox("Entrer un nom pour la recherche en cours:")
if NomQDF ="" then
 msgbox "Vous n'avez pas indiqué de nom valide pour la requête."
 exit sub
end if

'Création de la requête
CurrentDb.CreateQueryDef NomQDF, SQL
End Sub

Private Sub btnModifierRequête_Click()

'****************************
'Faculatif si la variable SQL mise à jour dans Sub RefreshQuery est de niveau module :
'Dim SQL As String
'SQL = Me!lstResults.RowSource
'****************************

'Modification de la requête
CurrentDb.QueryDefs("NomRequête").SQL = SQL
End Sub

Dim rct As Rectangle
Me.ssForm.SourceObject = "" 'on ferme le sous-formulaire
DoCmd.OpenForm "Formulaire", acDesign, , , , acHidden 'on le rouvre en mode création et caché
Set rct = CreateControl("Formulaire", acRectangle, , "", "", 200, 200, 3000, 9400) 'on trace le triangle
rct.BackColor = vbBlack
DoCmd.Close acForm, "Formulaire" 'on ferme le formulaire
Me.ssForm.SourceObject = "Formulaire" 'on rouvre le sous-formulaire dans le formulaire principal
Set rct = Nothing 'on libère la mémoire

gif.filename = gif.filename

Private Sub btnOuvrir_Click()
On Error GoTo Err_btnOuvrir_Click
    Dim stDocName As String
    Dim stLinkCriteria As String
    stDocName = "NomFormulaire"
    'On ne veut que certains enregistrements dans le formulaire à ouvrir
    'On ne veut donc que les enregistrements dont le champ ID est égal
    '  à la valeur du contrôle MonControleFiltre du formulaire
    stLinkCriteria = "[ID]=" & Me![MonControleFiltre] 
    'On ouvre le formulaire en passant le filtre en paramètre
    DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_btnOuvrir_Click:
    Exit Sub
Err_btnOuvrir_Click:
    If Err = 2501 Then Resume Exit_btnOuvrir_Click
    MsgBox Err.Description
    Resume Exit_btnOuvrir_Click
End Sub

Private Sub Form_Open(Cancel As Integer)
    If Me.RecordsetClone.RecordCount = 0 Then
        MsgBox "Le formulaire ne s'ouvre pas car il est vide.", vbInformation
        Cancel = True 'Annule l'ouverture
    End If
End Sub

PARAMETERS [Forms]![NomDuFormulaire]![NomDuChamp] Short;

Forms("Mon Form Principal").Controls("Mon Sous-formulaire").Form.RecordsetClone.RecordCount

Sub TestCtrl()
Dim Ctrl As control
    For Each Ctrl In Me.Controls
        If TypeOf Ctrl Is ComboBox Then
            If Ctrl.Value = "" Or IsNull(Ctrl.Value) Then
                MsgBox "Toutes les listes doivent avoir une information", vbOKOnly + vbExclamation, "Sélection"
                Ctrl.SetFocus
                Exit Sub
            End If
        End If
    Next Ctrl
End Sub

If TypeOf Ctrl Is ComboBox Then

If TypeOf Ctrl Is TextBox Then