Auteur : loufab
| | Version : 08/10/2005 | | |
| |
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 à
Le code complet de l'état devient alors :
Option Compare Database
Option Explicit
Private intTotalCount As Integer
Private Function SetCount(oReport As Report)
intTotalCount = 0
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
oReport.NextRecord = False
ElseIf (intTotalCount > TotalGroupe And intTotalCount < 20) Then
oReport.NextRecord = False
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
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
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.
|
| | 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:
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: 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: 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 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 rootHKeyClassesRoot = &H80000000
rootHKeyCurrentUser = &H80000001
rootHKeyLocalMachine = &H80000002
rootHKeyUsers = &H80000003 |
RRKREGSZ correspond à un type de valeur REG String RRKREGSZ = 1
RRKREGBINARY = 3
RRKREGDWORD = 4 |
|
| | 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. 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 : 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 Public Source_MonEtat as string |
Etape 2 : Sur le bouton BTimprimer du (ou des) formulaire(s) on aura le code suivant : 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 : 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 Public Nom_Formulaire as string |
Etape 2 : Sur le bouton BTimprimer du formulaire Monformulaire on aura le code suivant : 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 : 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 : 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.
|
 
|
