Les meilleures sources Access

Les meilleures sources AccessConsultez toutes les sources

Nombre d'auteurs : 44, nombre de sources : 147, création le 19 mars 2013

Sommaire→Etats

Créer des lignes continues (type facture, devis) même quand il n'y a plus d'enregistrement.
Exporter un état en PDF
Imprimer les données d'un formulaire dans un état
Création d'un état basé sur une requête analyse croisée
Importer les états d'une base MDE vers une base MDB

Version hors-ligne

Créer des lignes continues (type facture, devis) même quand il n'y a plus d'enregistrement.

Versions : Access 2000 et supérieures

L'exemple suivant se base sur le schéma de la base de données Les comptoirs (dans le répertoire Samples d'Office)

L'état est unique il ne comporte pas de sous-état pour l'affichage du détail de la facture. La source doit donc être composée d'une requête contenant la table Facture et Détails de Facture, la relation est faite par un N° de facture (N_FACTURE dans l'exemple). Cette requête doit contenir les champs des 2 tables que l'on souhaite voir apparaitre (ou que l'on a besoin) dans la facture. L'état est composé obligatoirement d'une entête de groupe sur N_FACTURE, de la zone Détail qui affichera les lignes de détails de la facture et d'un pied de groupe N_FACTURE. On peut avoir besoin d'une Entête et d'un pied de Page / formulaire.

Dans l'entête de groupe, créez un Textbox nommé txtTotalGroupe où la source de contrôle est égale à

Sélectionnez

=Count(*)

Le code complet de l'état devient alors :

Sélectionnez

Option Compare Database 
Option Explicit 
 
Private intTotalCount As Integer 
 
Private Function SetCount(oReport As Report) 
  intTotalCount = 0 
  'ici on indique les champs du détail 
  oReport![Réf produit].Visible = True 
  oReport![Nom du produit].Visible = True 
  oReport![Quantité].Visible = True 
  oReport![Prix unitaire].Visible = True 
  oReport![Remise (%)].Visible = True 
  oReport![PrixTotal].Visible = True 
End Function 
 
Private Function PrintLines(oReport As Report, _
ByVal TotalGroupe As Integer) 
   If Me.HasData Then 
      intTotalCount = intTotalCount + 1 
 
      If intTotalCount = TotalGroupe Then ' fini 
         oReport.NextRecord = False 
      ElseIf (intTotalCount > TotalGroupe And intTotalCount < 20) Then 
      'continue (14 lignes de détail) à vide 
         oReport.NextRecord = False 
      'ici on indique les champs du détail 
         oReport![Réf produit].Visible = False 
         oReport![Nom du produit].Visible = False 
         oReport![Quantité].Visible = False 
         oReport![Prix unitaire].Visible = False 
         oReport![Remise (%)].Visible = False 
         oReport![PrixTotal].Visible = False 
      End If 
      If intTotalCount = 20 Then 
      'ici on indique les champs du détail 
         oReport![Réf produit].Visible = False 
         oReport![Nom du produit].Visible = False 
         oReport![Quantité].Visible = False 
         oReport![Prix unitaire].Visible = False 
         oReport![Remise (%)].Visible = False 
         oReport![PrixTotal].Visible = False 
      End If 
  End If 
End Function 
 
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) 
  PrintLines Me, Me!txtTotalGroupe 
  ' traitements pour que les valeurs à zero n'apparaissent pas 
  Me![Réf produit].Visible = (Me![Prix unitaire] > 0) And _
   (Me![Prix unitaire].Visible = True) 
  Me![Nom du produit].Visible = (Me![Prix unitaire] > 0) And _
  (Me![Prix unitaire].Visible = True) 
  Me![Quantité].Visible = (Me![Prix unitaire] > 0) And _
  (Me![Prix unitaire].Visible = True) 
  Me![Remise (%)].Visible = (Me![Prix unitaire] > 0) And _
  (Me![Prix unitaire].Visible = True) 
 
End Sub 
 
Private Sub EnteteNoFacture_Format(Cancel As Integer, _
  FormatCount As Integer) 
  SetCount Me 
End Sub

Lancer l'état en mode aperçu, le résultat est immédiat.

Notez que le code est à modifier suivant les contrôles figurant sur votre état.

Créé le 8 octobre 2005 par loufab

Page de l'auteur

Exporter un état en PDF

Versions : 2000 et supérieures

Valable aussi pour: Word ou Excel en adaptant le code (DoCmd.OpenReport...) , l'élément essentiel étant l'entrée dans le registre.

Intérêt : Eviter d'avoir la boîte de dialogue de confirmation du nom du fichier PDF à créer, ce qui est primordial.

Note importante : L'ensemble du code ci-dessous est destiné à être utilisé avec PDFWriter d' Acrobat.
De plus, l'installation d'Acrobat doit être faite en mode personnalisé afin de cocher la case PDFWriter qui n'est pas installé en mode Par défaut.

Obtention et définition temporaire dynamique des paramètres d'impression:

Sélectionnez

Option Compare Database 
Option Explicit 
 
Private originalPrinter As String 
Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
  (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpDefault$, _
  ByVal lpReturnedString$, ByVal nSize&) As Long 
 
Public Declare Function WriteProfileString Lib "kernel32" Alias _
 "WriteProfileStringA" (ByVal lpszSection$, ByVal lpszKeyName$, _
   ByVal lpszString$) As Long 
 
Public Function fnctGetDefaultPrinter() As String 
Dim nSize As Integer 
Dim strPrinterName As String 
Dim successReturn& 
Dim iPos1 As Integer, iPos2 As Integer 
    nSize = 81 
    strPrinterName = Space(nSize) 
        successReturn = GetProfileString("windows", "device", _
                  vbNullString, strPrinterName, nSize) 
        strPrinterName = Left(strPrinterName, successReturn) 
        iPos1 = InStr(1, strPrinterName, ",") 
        iPos2 = InStr(iPos1 + 1, strPrinterName, ",") 
    strPrinterName = Left(strPrinterName, iPos1 - 1) 
    fnctGetDefaultPrinter = strPrinterName 
End Function 
 
Private Sub subGetDriverAndPort(ByVal Buffer As String, _
  ByRef DriverName As String, ByRef PrinterPort As String) 
 
Dim posDriver As Integer 
Dim posPort As Integer 
 
  DriverName = vbNullString 
  PrinterPort = vbNullString 
  posDriver = InStr(Buffer, ",") 
  If posDriver > 0 Then 
    DriverName = Left(Buffer, posDriver - 1) 
    posPort = InStr(posDriver + 1, Buffer, ",") 
    If posPort > 0 Then 
        PrinterPort = Mid(Buffer, posDriver + 1, posPort - posDriver - 1) 
    End If 
  End If 
End Sub 
 
Private Sub SetDefaultPrinter(ByVal PrinterName As String) 
Dim Buffer As String 
Dim DeviceName As String 
Dim DriverName As String 
Dim PrinterPort As String 
Dim DeviceLine As String 
  Buffer = Space(1024) 
  Call GetProfileString("PrinterPorts", PrinterName, vbNullString, _
      Buffer, Len(Buffer)) 
  subGetDriverAndPort Buffer, DriverName, PrinterPort 
  If DriverName <> vbNullString And PrinterPort <> vbNullString Then 
    DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort 
    Call WriteProfileString("windows", "Device", DeviceLine) 
  End If 
End Sub

Création du PDF:

Sélectionnez

Private Sub subCreatePDFFromReport(ByVal ReportName As String, _
  ByVal PDFFileName As String) 
  originalPrinter = fnctGetDefaultPrinter() 
  SetDefaultPrinter "Acrobat PDFWriter" 
  subRegistrySetKeyValue rootHKeyCurrentUser, _
   "Software\Adobe\Acrobat PDFWriter\", "PDFFileName", _
     PDFFileName, RRKREGSZ 
 
  DoCmd.OpenReport ReportName, 0 
  SetDefaultPrinter originalPrinter 
End Sub

Mode d'utilisation:

Sélectionnez

Private Sub ImprimerPDF() 
  subCreatePDFFromReport "Etat PDF", "C:\Poubelle\PDF\FactureClient.pdf" 
End Sub

Informations supplémentaires:

subRegistrySetKeyValue est une procédure pour écrire une valeur dans la Registre

Sélectionnez

Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal lngHKey As Long) As Long 
 
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
"RegCreateKeyExA" (ByVal lngHKey As Long, ByVal lpSubKey As String, _
ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, _
ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, _
phkResult As Long, lpdwDisposition As Long) As Long 
 
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal lngHKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, _
phkResult As Long) As Long 
 
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, _
lpcbData As Long) As Long 
 
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, lpType As Long, lpData As Long, _
lpcbData As Long) As Long 
 
Private Declare Function RegQueryValueExBinary Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, _
lpcbData As Long) As Long 
 
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, _
lpcbData As Long) As Long 
 
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, _
ByVal cbData As Long) As Long 
 
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData As Long) As Long 
 
Private Declare Function RegSetValueExBinary Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As Long, _
ByVal cbData As Long) As Long 
 
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias _
"RegEnumKeyA" (ByVal lngHKey As Long, ByVal dwIndex As Long, _
ByVal lpName As String, ByVal cbName As Long) As Long 
 
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias _
"RegQueryInfoKeyA" (ByVal lngHKey As Long, ByVal lpClass As String, _
ByVal lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, _
lpcbMaxSubKeyLen As Long, ByVal lpcbMaxClassLen As Long, lpcValues As Long, _
lpcbMaxValueNameLen As Long, ByVal lpcbMaxValueLen As Long, _
ByVal lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long 
 
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias _
"RegEnumValueA" (ByVal lngHKey As Long, ByVal dwIndex As Long, _
ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, _
ByVal lpType As Long, ByVal lpData As Byte, ByVal lpcbData As Long) As Long 
 
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias _
"RegDeleteKeyA" (ByVal lngHKey As Long, ByVal lpSubKey As String) As Long 
 
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias _
"RegDeleteValueA" (ByVal lngHKey As Long, _
ByVal lpValueName As String) As Long 
 
Private Const MCREGKEYALLACCESS = &H3F 
Private Const MCREGKEYQUERYVALUE = &H1 
Private Const mcregOptionNonVolatile = 0
 
Private Type FILETIME 
  dwLowDateTime As Long 
  dwHighDateTime As Long 
End Type 
 
Public Enum EnumRegistryRootKeys 
  rootHKeyClassesRoot = &H80000000 
  rootHKeyCurrentUser = &H80000001 
  rootHKeyLocalMachine = &H80000002 
  rootHKeyUsers = &H80000003 
End Enum 
 
Public Enum EnumRegistryValueType 
  RRKREGSZ = 1 
  RRKREGBINARY = 3 
  RRKREGDWORD = 4 
End Enum 
 
Public Sub subRegistrySetKeyValue(ByVal RootKey As EnumRegistryRootKeys, _
ByVal KeyName As String, ByVal ValueName As String, ByVal varData As Variant, _
ByVal DataType As EnumRegistryValueType) 
 
  Dim lReturn As Long 
  Dim lHKey As Long 
  Dim sData As String 
  Dim lData As Long 
  Dim aData() As Byte 
 
  On Error GoTo L_ErrRegistryOperation 
  lReturn = RegCreateKeyEx(RootKey, KeyName, 0&, vbNullString, _
       mcregOptionNonVolatile, MCREGKEYALLACCESS, 0&, lHKey, 0&) 
  Select Case DataType 
  Case RRKREGSZ 
    sData = varData & vbNullChar 
    lReturn = RegSetValueExString(lHKey, ValueName, 0&, DataType, _
        sData, Len(sData)) 
  Case RRKREGDWORD 
    lData = varData 
    lReturn = RegSetValueExLong(lHKey, ValueName, 0&, DataType, _
    lData, Len(lData)) 
  Case RRKREGBINARY 
    aData = varData 
    lReturn = RegSetValueExBinary(lHKey, ValueName, 0&, DataType, _
     VarPtr(aData(0)), UBound(aData) + 1) 
  End Select 
  RegCloseKey (lHKey) 
 
L_ExRegistryOperation: 
  Erase aData 
  Exit Sub 
L_ErrRegistryOperation: 
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
   "subRegistrySetKeyValue" 
  Resume L_ExRegistryOperation 
End Sub

rootHKeyCurrentUser correspond à HKEY_CURRENT_USER

Sélectionnez

  rootHKeyClassesRoot = &H80000000 
  rootHKeyCurrentUser = &H80000001 
  rootHKeyLocalMachine = &H80000002 
  rootHKeyUsers = &H80000003

RRKREGSZ correspond à un type de valeur REG String

Sélectionnez

  RRKREGSZ = 1 
  RRKREGBINARY = 3 
  RRKREGDWORD = 4

Mis à jour le 29 septembre 2005 par Argyronet

Page de l'auteur

Imprimer les données d'un formulaire dans un état

Versions : 97 et supérieures

Tout d'abord, il faut que l'état possède les mêmes champs que le formulaire.
Ensuite, il risque d'y avoir plusieurs cas.
Dans les exemples, je vais prendre le cas d'un formulaire nommé monformulaire qui possède un bouton nommé BTimprimer et d'un état nommé MonEtat.

1. Le cas le plus simple :
L'utilisateur clique sur BTimprimer, l'état s'ouvre et le formulaire reste ouvert.

Etape 1 : Sur le bouton imprimer,il faut écrire le code qui va ouvrir l'état en mode aperçu. Ce code peut être réalisé à l'aide de l'assistant de création de bouton.

Sélectionnez

Private Sub BTImprimer_Click() 
Dim Nom_Etat as string 
Nom_Etat="MonEtat" 
DoCmd.OpenReport Nom_Etat, acPreview 
End Sub

Etape2 : Sur l'évenement Open de l'état on écrira le code :

Sélectionnez

Private Sub Report_Open(Cancel as integer) 
Me.RecordSource=Forms.Item("MonFormulaire").recordsource 
End Sub

Comment ça marche : Le bouton du formulaire ouvre l'état ce qui a pour effet de déclencher l'évenement Open de l'état qui affecte à la propriété RecordSource de MonEtat, la valeur de celle de MonFormulaire.

2. Un cas plus complexe :
MonEtat peut être ouvert depuis plusieurs formulaires. Dans ce cas, on va avoir besoin d'une variable publique que l'on va placer dans un module. Même si effectivement, l'utilisation de variables publiques est à proscrire en général, cela reste le moyen le plus simple de parvenir à nos fins.

Etape 1 : Donc dans un module on déclare une variable publique

Sélectionnez

Public Source_MonEtat as string

Etape 2 : Sur le bouton BTimprimer du (ou des) formulaire(s) on aura le code suivant :

Sélectionnez

Private Sub BTImprimer_Click() 
Dim Nom_Etat as string 
Nom_Etat="MonEtat" 
Source_MonEtat=Me.recordsource 
DoCmd.OpenReport Nom_Etat, acPreview 
End Sub

Etape3 : Sur l'évenement Open de l'état on écrira le code :

Sélectionnez

Private Sub Report_Open(Cancel as integer) 
Me.RecordSource=Source_MonEtat 
End Sub

Comment ça marche : Le bouton du formulaire affecte à la variable publique la valeur de la propriété RecordSource du formulaire puis ouvre l'état ce qui a pour effet de déclencher l'évenement Open de MonEtat qui affecte à la propriété RecordSource de MonEtat, la valeur de la variable publique.

3. Dans le même genre :

MonEtat doit imprimer les données d'un autre formulaire ouvert autre que celui où se trouve BTimprimer. On prendra le cas où l'état doit imprimer le contenu du formulaire MonAutreFormulaire. Dans ce cas aussi, on va avoir besoin d'une variable publique que l'on va placer dans un module.

Etape 1 : Donc dans un module on déclare une variable publique

Sélectionnez

Public Nom_Formulaire as string

Etape 2 : Sur le bouton BTimprimer du formulaire Monformulaire on aura le code suivant :

Sélectionnez

Private Sub BTImprimer_Click() 
Dim Nom_Etat as string 
Nom_Etat="MonEtat" 
Nom_Formulaire="MonAutreFormulaire" 
DoCmd.OpenReport Nom_Etat, acPreview 
End Sub

Etape3 : Sur l'évenement Open de l'état on écrira le code :

Sélectionnez

Private Sub Report_Open(Cancel as integer) 
Me.RecordSource=Forms.item(Nom_formulaire).recordsource 
End Sub

Comment ça marche : Le bouton BtImprimer renseigne dans la variable publique le nom du formulaire à interroger, puis ouvre l'état ce qui a pour effet de déclencher l'évenement Open de MonEtat qui interroge alors le bon formulaire pour remplir sa source d'enregistrement avec celle du formulaire concerné.

4. En passant par le mode création de l'état

Dans ce cas, l'état va d'abord être ouvert en mode création puis le code va remplir la propriété RecordSource de l'état et enfin afficher l'état en mode prévisualisation.

Etape 1 : Sur le bouton BTimprimer du formulaire on aura le code suivant :

Sélectionnez

Private Sub BTImprimer_Click() 
Dim Nom_Etat as string 
Nom_Etat="MonEtat" 
DoCmd.OpenReport Nom_Etat, acViewDesign, , , acHidden
Reports.item(Nom_etat).Recordsource=me.recordsource 
Docmd.Close acReport,Nom_Etat,acYes
DoCmd.OpenReport Nom_Etat, acPreview 
End Sub

Notez que le paramètre acHidden permet d'ouvrir l'état en mode caché afin de réaliser les modifications. Ce paramètre n'est disponible que sur les versions 2000 et supérieures. Pour la version 97, vous devez enlever ce paramètre.

Créé le 28 janvier 2005 par Tofalu

Page de l'auteur

Création d'un état basé sur une requête analyse croisée

Le problème des requêtes analyse croisée est que le nombre de champs varie en fonction du résultat retourné par la requête à un instant T.
On fixe dès le départ le nombre de colonnes maximum de l'état même si on n'en affichera moins que ce maximum. Le problème étant aussi que si l'état dépasse une page en largeur il faudrait qu'il dépasse cette page tout le temps. Si les champs ne sont pas trop larges on peut en afficher une quinzaine.

La 1ère chose à faire : créer la requête analyse croisée
La seconde : créer l'état !!

La source de l'état sera bien évidemment la requête analyse croisée.
Nous allons créer les labels, textbox.

Les textbox seront toutes indépendantes

Prenons l'exemple de vendeurs avec leur chiffre d'affaire mensuel.

Nommer les textbox de l'entête de page Entete1, Entete2..etc.
Les textbox de l'entête comprendront pour la 1ère : la description suivante " Nom Vendeur " et les suivants contiendront les mois et années (Septembre 05, Octobre 05, ?Juillet 06, Août 06).

Dans le détail : les champs seront nommés Detail1, Detail2 etc...
Detail1 va contenir, pour chaque enregistrement, le nom du vendeur, Nombre2 et suivants vont recevoir les CA correspondant au mois.

Dans le pied d'état : les textbox seront nommées Total1 (avec pour valeur : Total c'est l'étiquette en fait), Total2, Total3.... vont effectuer la somme des champs Detail correspondants.

Les textbox permettront d'avoir des colonnes et des lignes créées dynamiquement en fonction du résultat de la requête.
Voici maintenant le code à placer dans l'état :

Sélectionnez

' ***** déclaration des variables ***** ' 
Const Nombre_colonnes = 13 ' Nombre maximum d'étiquettes sur l'état (par rapport à l'exemple) & _ 
    on peut en afficher plus et donc modifier cette variable 
Dim dbBase As DAO.Database 
Dim rstEnregistrement As DAO.Recordset 
Dim NbColonnes As Integer 
Dim Total_colonnes(1 To Nombre_colonnes) As Long 
Dim Total_etat As Long

Détail : Au formatage

Sélectionnez

Private Sub Détail_Format(Cancel As Integer, FormatCount As Integer) 
 
    Dim entX As Integer 
 
    If Not rstEnregistrement.EOF Then 
        If Me.FormatCount = 1 Then 
            For entX = 1 To NbColonnes 
                Me("Detail" + Format(entX)) = Nz(rstEnregistrement(entX - 1), 0) 
            Next entX 
 
            For entX = NbColonnes + 2 To Nombre_colonnes 
                Me("Detail" + Format(entX)).Visible = False 
            Next entX 
 
            rstEnregistrement.MoveNext 
        End If 
    End If 
 
End Sub

Détail : sur impression

Sélectionnez

Private Sub Détail_Print(Cancel As Integer, PrintCount As Integer) 
 
    Dim entX As Integer 
    Dim Nblignes As Long 
 
    If Me.PrintCount = 1 Then 
        Nblignes = 0 
 
        For entX = 2 To NbColonnes 
            Nblignes = Nblignes + Me("Detail" + Format(entX)) 
            Total_colonnes(entX) = Total_colonnes(entX) + Me("Detail" + Format(entX)) 
        Next entX 
 
        Me("Detail" + Format(NbColonnes + 1)) = Nblignes 
        Total_état = Total_état + Nblignes 
    End If 
 
End Sub

Détail : au reformatage

Sélectionnez

Private Sub Détail_Retreat() 
 
    rstEnregistrement.MovePrevious 
 
End Sub

Entête état : Au formatage

Sélectionnez

Private Sub EntêteÉtat_Format(Annuler As Integer, FormatCount As Integer) 
 
    rstEnregistrement.MoveFirst 
    Initvar 
 
End Sub

Entête de page : au formatage

Sélectionnez

Private Sub EntêtePage_Format(Annuler As Integer, FormatCount As Integer)
' Pour la version 2002 : remplacer EntêtePage_Format par Zone EntêtePage_Format. A voir pour les autres versions
 
    Dim entX As Integer 
 
    ' Met les entêtes de colonnes 
    ' dans des zones de texte dans la section Entête. 
    For entX = 1 To NbColonnes 
        Me("Entete" + Format(entX)) = rstEnregistrement(entX - 1).Name 
    Next entX 
 
    ' Crée l'entête Totaux de la prochaine zone de liste disponible. 
    Me("Entete" + Format(NbColonnes + 1)) = "Totaux" 
 
    ' Cache les zones de texte inutilisées dans la section Entête. 
    For entX = (NbColonnes + 2) To Nombre_colonnes 
        Me("Entete" + Format(entX)).Visible = False 
    Next entX 
 
End Sub

Pied d'état : au formatage

Sélectionnez

Private Sub PiedÉtat_Format(Annuler As Integer, NBimpression As Integer) 
 
    Dim entX As Integer 
 
    ' Affecte la valeur Total_Colonne(entX) des champs en colonne au champs total
    For entX = 2 To NbColonnes 
        Me("Total" + Format(entX)) = Total_colonnes(entX) 
    Next entX 
 
    ' Place TotalEtat dans une boite de texte dans le pied d'état. 
    Me("Total" + Format(NbColonnes + 1)) = Total_état 
 
    ' Cache les zones de texte inutilisées dans le pied d'état. 
    For entX = (NbColonnes + 2) To Nombre_colonnes 
        Me("Total" + Format(entX)).Visible = False 
    Next entX 
 
End Sub

Etat : sur fermeture

Sélectionnez

Private Sub Report_Close() 
 
    rstEnregistrement.Close 
 
End Sub

Etat : sur aucune données

Sélectionnez

Private Sub Report_NoData(Annuler As Integer) 
 
    MsgBox "Aucun enregistrement n'a été trouvé.", vbExclamation, "Information" 
    rstEnregistrement.Close 
    Annuler = True 
 
End Sub

Etat : sur ouverture

Sélectionnez

Private Sub Report_Open(Annuler As Integer) 
 
    Dim rstRequete As DAO.QueryDef 
 
    Set dbBase = CurrentDb 
    Set rstRequete = dbBase.QueryDefs("NomRequeteAnalyseCroisée") 
    Set rstEnregistrement = rstRequete.OpenRecordset() 
 
    'Définit le nombre de colonnes de la requête 
    NbColonnes = rstRequete.Fields.Count 
 
End Sub

Procédure et fonction à placer dans l'état :
Sub Initvar

Sélectionnez

Private Sub Initvar() 
 
    Dim entX As Integer 
    Total_etat = 0 
 
    For entX = 1 To NbColonnes 
        Total_colonnes(entX) = 0 
    Next entX 
 
End Sub

Créé le 15 novembre 2006 par cafeine

Importer les états d'une base MDE vers une base MDB

Voici une fonction permettant d'importer les états d'une base .mde vers une base .mdb.

Sélectionnez

Public Sub ImporterEtat(strChemin As String, strNomEtat As String)
 
    'StrChemin correspond au chemin du fichier MDE
    'StrNomEtat correspond au nom de l'état
    Dim AppAccess As New Access.Application
    Dim oRptSource As Access.Report, oRptDest As Access.Report
    Dim oCtlSource As Control
    Dim i As Integer
    'Ouvre le fichier mde
    AppAccess.OpenCurrentDatabase strChemin
    'Ouvre l'état en mode aperçu
    AppAccess.DoCmd.OpenReport strNomEtat, acViewPreview
    'Atteint l'objet Etat
    Set oRptSource = AppAccess.Reports(strNomEtat)
    'Crée le nouvel état dans la base de données courant
    Set oRptDest = CreateReport
    'Fixe les mêmes propriétés
    DupliqueProprietes oRptSource, oRptDest
    'Parcours les controls
    For Each oCtlSource In oRptSource.Controls
        CreerControle oRptDest.name, oCtlSource
    Next oCtlSource
    'Engregistre l'état
    DoCmd.Save acReport, oRptDest.name
    'ferme l'état source
    AppAccess.DoCmd.Close acReport, strNomEtat, acSaveNo
    'Ferme le mde
    AppAccess.DoCmd.Quit
    'Libère la mémoire
 
    Set AppAccess = Nothing: Set oRptDest = Nothing: Set oRptSource = Nothing
    Set oCtlSource = Nothing
 
End Sub
 
Private Function CreerControle(strNomEtat As String, oCtlSource As Object)
On Error GoTo err:
 
    Dim oCtlDest As Object
    Set oCtlDest = CreateReportControl(strNomEtat, oCtlSource.ControlType, oCtlSource.Section)
    DupliqueProprietes oCtlSource, oCtlDest
 
err:
 
End Function
 
Private Function DupliqueProprietes(ObjetSource As Object, ObjetDest As Object)
On Error GoTo err
 
    Dim Prp As Object
    For Each Prp In ObjetSource.Properties
        CloneProprietes ObjetDest, Prp
    Next Prp
 
err:
 
End Function
 
Private Function CloneProprietes(ObjetDest As Object, PrpSource As Object)
On Error GoTo err
 
    ObjetDest.Properties(PrpSource.name).Value = PrpSource.Value
 
err:
 
End Function

Créé le 16 janvier 2007 par Tofalu

Page de l'auteur

Version hors-ligne

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2013 Maxence Hubiche Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.