currentproject.AllForms("NomDuForm").IsLoaded

Function IsLoaded(ByVal strFormName As String) As Integer 
 ' Retourne True si le formulaire spécifié est ouvert.
    
    Const conObjStateClosed = 0
    Const conDesignView = 0
    
    If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> conObjStateClosed Then
        If Forms(strFormName).CurrentView <> conDesignView Then
            IsLoaded = True
        End If
    End If
End Function

Public Function is_form_opened(fname As String) As Boolean 

On Error GoTo not_opened
Dim LeFichier As String

LeFichier = Forms(fname).Name
is_form_opened = True
Exit Function

not_opened: If (Err.Number = 2450) Then
     is_form_opened = False
     err.clear
End If

End Function

   ' Déclaration dans chaque formulaire après Option Explicit et Option Compare Database
Private WithEvents clsMouseWheel As MouseWheel.CMouseWheel

 'Procédure à rajouter dans chaque formulaire
Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
    Cancel = True
End Sub

Private Sub Form_Load()
        'Code à rajouter dans l'événement chargement de chaque formulaire   
    Set clsMouseWheel = New MouseWheel.CMouseWheel
    Set clsMouseWheel.Form = Me
    clsMouseWheel.SubClassHookForm
End Sub

Private Sub Form_Close()
    'Code à rajouter dans l'événement fermeture de chaque formulaire
    If Not (clsMouseWheel Is Nothing) Then
        clsMouseWheel.SubClassUnHookForm
        Set clsMouseWheel.Form = Nothing
        Set clsMouseWheel = Nothing
    End If
End Sub

DoCmd.OpenForm "NomFormulaire", acFormDS ...

Call Form_NomDuSousForm.Champ_AfterUpdate

Public Sub Champ_AfterUpdate()
    'Code à exécuter
    ....
End Sub

"[nom_champ] =" & Forms![nom_formulaire]![nom_contrôle dans autre formulaire]

"[nom_champ] =" & Me.[MonControle]

DoCmd.Close

DoCmd.Close acForm, "F_MonForm"

Me.ShortcutMenu = False

Sub MonMessage(txt As String)
    MsgBox txt
End Sub

MonMessage "coucou"

Forms!Form2!MonContôle.SetFocus 

DoCmd.SelectObject acForm, Form2, False  

Private Sub Form_Unload(Cancel As Integer)
If MsgBox("Etes-vous certain ?", vbYesNo) = vbNo Then Cancel = True
End Sub

Forms!NomAutreForm.NomSub

Public Sub NomSub()
    'Code à exécuter
    ....
End Sub

Select Nom, Prenom From Table

Private function Cells(Ligne as integer,Colonne as integer) as string
On error goto err
Dim R as dao.recordset
set r=me.recordsetclone
r.movefirst
While Ligne>0
r.movenext
ligne=ligne-1
Wend
Cells=R.fields(Colonne).value
err:
End Function

MsgBox Cells(3,4)

Private function Cells(Ligne as integer,Colonne as string) as string
On error goto err
Dim R as dao.recordset
set r=me.recordsetclone
r.movefirst
While Ligne>0
r.movenext
ligne=ligne-1
Wend
Cells=R.fields(Colonne).value
err:
End Function

MsgBox Cells(2,"Nom")

DoCmd.GoToRecord acDataForm, Me.name, acNewRec

DoCmd.Minimize

Me.Caption = "Nouveau nom du formulaire"

DoCmd.OpenForm "F_AFFICHAGE"
Forms("F_AFFICHAGE").Printer.Orientation = acPRORLandscape
DoCmd.PrintOut
DoCmd.Close acForm, "F_AFFICHAGE"

Public Function GetDescForm(strFormName As String) As String
Dim oDb As DAO.Database
Set oDb = CurrentDb
GetDateUpdatedForm = oDb.Containers("Forms").Documents(strFormName).Properties("Description")
End Function

Sub test()
MsgBox GetDescForm("Formulaire1")
End Sub

Public Function GetDateUpdatedForm(strFormName As String) As Date
Dim oDb As DAO.Database
Set oDb = CurrentDb
GetDateUpdatedForm = oDb.Containers("Forms").Documents(strFormName).LastUpdated
End Function

Sub test()
MsgBox GetDateUpdatedForm("Formulaire1")
End Sub

Public Sub CloseAllForms()
Do WHILE Forms.Count
    Docmd.Close acForm, Forms(0).Name
Loop
End Sub

Global gBol as Boolean

Private Sub MonEtiquette_Click()
    Me.OrderByOn = True
    If gBol = False Then
        Me.OrderBy = "MaColonne asc"
        gBol = True
    Else
        Me.OrderBy = "MaColonne desc"
        gBol = False
    End If
 
End Sub

Sub ecrireDecr()
On Error GoTo err
'Script qui affecte la date et l'heure à la propriété Description
' d'un formulaire
Dim oDb As DAO.Database
Dim oDoc As DAO.Document
Set oDb = CurrentDb
Set oDoc = oDb.Containers("Forms").Documents("MonFormulaire")
oDoc.Properties("Description") = Now
 
fin:
Exit Sub
 
err:
Select Case err.Number
    Case 3270 'Si la propriété n'existe pas la créer
        With oDoc
            .Properties.Append .CreateProperty("Description", dbText, Now)
            .Properties.Refresh
        End With
    Case Else
        err.Raise err.Number
End Select
Resume fin
End Sub

Option Compare Database

Public ExpiredTime
'

Sub Form_Timer()
' IDLEMINUTES determines how much idle time to wait for before
         ' running the IdleTimeDetected subroutine.
         Const IDLEMINUTES = 0.05
 
         Static PrevControlName As String
         Static PrevFormName As String
 
         Dim ActiveFormName As String
         Dim ActiveControlName As String
         Dim ExpiredMinutes

         On Error Resume Next
 
         ' check le forumulaire active et le control name
 
         ActiveFormName = Screen.ActiveForm.Name
         If Err Then
            ActiveFormName = "No Active Form"
            Err = 0
         End If
 
         ActiveControlName = Screen.ActiveControl.Name
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
         
         ' verifie actif actuel and reinitialise temps expiration si:
         '    1. aucun enregistrement d'action encore (code roule pour
         '       la premiere fois).
         '    2. les noms precedents sont differents des noms courants
         '       (usager a fait quelque chose de different pendant l'intervalle de temps
           If (PrevControlName = "") Or (PrevFormName = "") _
           Or (ActiveFormName <> PrevFormName) _
           Or (ActiveControlName <> PrevControlName) Then
            PrevControlName = ActiveControlName
            PrevFormName = ActiveFormName
            ExpiredTime = 0
         Else
            ' ...otherwise the user was idle during the time interval, so
            ' increment the total expired time.
            ExpiredTime = ExpiredTime + Me.TimerInterval
         End If
 
         ' Does the total expired time exceed the IDLEMINUTES?
         ExpiredMinutes = (ExpiredTime / 1000) / 60
         If ExpiredMinutes >= IDLEMINUTES Then
            ' ...si oui, je reset le temps d'expiration a 0...
            ExpiredTime = 0
            ' ...et appelle la sous-routine idletimedetected.
            IdleTimeDetected ExpiredMinutes
         End If
End Sub

Sub IdleTimeDetected(ExpiredMinutes)
         Dim Msg As String
         Msg = "Aucune activite "
         Msg = Msg & ExpiredMinutes & " minute(s)!"
         MsgBox Msg, 48
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not IsNull(KeyCode) Then
         ExpiredTime = 0
    End If
End Sub

DoCmd.OpenForm NomFormulaire, acDesign, , , , acHidden
    Forms![NomFormulaire]![NomEtiquette].Caption = "Nouvelle légende"
    DoCmd.Close acForm, NomFormulaire, acSaveYes
    DoCmd.OpenForm NomFormulaire

Private Sub Form_Load()
Me.InsideHeight = Me.Section(acHeader).Height + Me.Section(acFooter).Height + Me.RecordsetClone.RecordCount * Me.Section(acDetail).Height
End Sub

Private Sub Form_Current()
Me.TonSousForm.Form.InsideHeight = Me.TonSousForm.Form.Section(acHeader).Height _
     + Me.TonSousForm.Form.Section(acFooter).Height _
     + Me.TonSousForm.Form.Section(acDetail).Height _
         * (Me.TonSousForm.Form.RecordsetClone.RecordCount _
          -  Me.TonSousForm.Form.AllowAdditions)
Me.TonSousForm.Height = Me.TonSousForm.Form.WindowHeight
End Sub

Me.TazoneDeTexte.Top = Me.TonSousForm.Top + Me.TonSousForm.Height + AutantDeTwipsQueTuVeux

 Dim objSousForm As Object
    Dim frmSousForm As Form
    Dim nbMaxLignes As Long
 
    'Vos déclarations
    Set objSousForm = Me!TonSousForm
    Set frmSousForm = objSousForm.Form
    nbMaxLignes = 3     'limite la hauteur à n lignes et affiche le défilement vertical
 
    
    If frmSousForm.RecordsetClone.RecordCount <= nbMaxLignes Then
        frmSousForm.InsideHeight = frmSousForm.Section(acHeader).Height _
                                 + frmSousForm.Section(acFooter).Height _
                                 + frmSousForm.Section(acDetail).Height _
                                 * (frmSousForm.RecordsetClone.RecordCount _
                                  - frmSousForm.AllowAdditions)
        objSousForm.Height = frmSousForm.WindowHeight
        frmSousForm.ScrollBars = 0  'aucune barre de défilement
    Else
        frmSousForm.InsideHeight = frmSousForm.Section(acHeader).Height _
                                 + frmSousForm.Section(acFooter).Height _
                                 + frmSousForm.Section(acDetail).Height _
                                 * (nbMaxLignes - frmSousForm.AllowAdditions)
        objSousForm.Height = frmSousForm.WindowHeight
        frmSousForm.ScrollBars = 2  'barre de défilement verticale
    End If
 
 
    'Après, s'il y a des zones de textes en-dessous, il suffit de
    'modifier leur position en fonction du sous-formulaire,
    'par exemple :
 
    Me.TaZoneDeTexte.Top = objSousForm.Top + objSousForm.Height  + AutantDeTwipsQueTuVeux
 
 
    Set objSousForm = Nothing
    Set frmSousForm = Nothing