Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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 SubQuelle erreur ais-je pu commettre ?
Au regard de ce que vous m'avez fourni, la procédure SubImprimerPDF()
n'existe pas dans votre code. Il vous faut la rédiger avec les paramètres
requis.
De plus, vous n'êtes pas obligé d'affecter le bouton à une macro mais à un
événement.
Par ailleurs, ne nommez pas vos modules avec des espaces.
Nommez les "basAdobePDF" et "basRegistre"
Je vous recommande la lecture de ce tuto :
http://argyronet.developpez.com/office/vba/convention/
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
Quelle erreur ais-je pu commettre ?
Au regard de ce que vous m'avez fourni, la procédure SubImprimerPDF()
n'existe pas dans votre code. Il vous faut la rédiger avec les paramètres
requis.
De plus, vous n'êtes pas obligé d'affecter le bouton à une macro mais à un
événement.
Par ailleurs, ne nommez pas vos modules avec des espaces.
Nommez les "basAdobePDF" et "basRegistre"
Je vous recommande la lecture de ce tuto :
http://argyronet.developpez.com/office/vba/convention/
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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 SubQuelle erreur ais-je pu commettre ?
Au regard de ce que vous m'avez fourni, la procédure SubImprimerPDF()
n'existe pas dans votre code. Il vous faut la rédiger avec les paramètres
requis.
De plus, vous n'êtes pas obligé d'affecter le bouton à une macro mais à un
événement.
Par ailleurs, ne nommez pas vos modules avec des espaces.
Nommez les "basAdobePDF" et "basRegistre"
Je vous recommande la lecture de ce tuto :
http://argyronet.developpez.com/office/vba/convention/
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
PDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
PDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
PDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
PDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
PDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
PDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
Autant pour moi, j'avais oublié de supprimer certaines références dans
Microsoft Visual Basic - Outils - Références.
Maintenant ça marche et très bien; je produis bien un fichier Adobe Acrobat
Output.pdf dans le bon directory.
Je reviens à un eperfectionnement précisé dans ma première demande:
Est il possible de remplacer le nom Output.pdf, par un nom composé d'une
constante "Réponse" et d'un champ alpha variable "RéfDossier" situé dans le
formulaire et dans l'Etat, soit par exemple "Réponse B22007-12-52MJK"?
Tous mes remerciements
AlainPDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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, _
Autant pour moi, j'avais oublié de supprimer certaines références dans
Microsoft Visual Basic - Outils - Références.
Maintenant ça marche et très bien; je produis bien un fichier Adobe Acrobat
Output.pdf dans le bon directory.
Je reviens à un eperfectionnement précisé dans ma première demande:
Est il possible de remplacer le nom Output.pdf, par un nom composé d'une
constante "Réponse" et d'un champ alpha variable "RéfDossier" situé dans le
formulaire et dans l'Etat, soit par exemple "Réponse B22007-12-52MJK"?
Tous mes remerciements
Alain
PDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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, _
Autant pour moi, j'avais oublié de supprimer certaines références dans
Microsoft Visual Basic - Outils - Références.
Maintenant ça marche et très bien; je produis bien un fichier Adobe Acrobat
Output.pdf dans le bon directory.
Je reviens à un eperfectionnement précisé dans ma première demande:
Est il possible de remplacer le nom Output.pdf, par un nom composé d'une
constante "Réponse" et d'un champ alpha variable "RéfDossier" situé dans le
formulaire et dans l'Etat, soit par exemple "Réponse B22007-12-52MJK"?
Tous mes remerciements
AlainPDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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, _
Bien entendu...
Le nom du fichier de sortie est représenté par une variable de type String...
Vous pouvez alors construire un nom de fichier tel que vous l'entendez ;
Par exemple :
Sub ImprimerPDF()
Const PREFIXE_FICHIER As String = "Réponse "
Dim strRéfDossier As String 'Ici = à B22007-12-52MJK
Dim strNomDuPDF As String
Dim strDossier As String
If IsNull(Me!strRéfDossier) Then
MsgBox "Vous devez préciser le N° de dossier avant de générer le PDF !",
48
Me!strRéfDossier.SetFocus
Exit Sub
Else
strDossier = Application.CurrentProject.Path & "PDF"
'Par exemple U:Développement
strNomDuPDF = strDossier & PREFIXE_FICHIER & strRéfDossier & ".pdf"
'Ici : Réponse B22007-12-52MJK.pdf
Call subCreatePDFFromReport("Votre état", strNomDuPDF)
End If
End Sub
Bon courage et bravo, vous avez réussi !!!
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )Autant pour moi, j'avais oublié de supprimer certaines références dans
Microsoft Visual Basic - Outils - Références.
Maintenant ça marche et très bien; je produis bien un fichier Adobe Acrobat
Output.pdf dans le bon directory.
Je reviens à un eperfectionnement précisé dans ma première demande:
Est il possible de remplacer le nom Output.pdf, par un nom composé d'une
constante "Réponse" et d'un champ alpha variable "RéfDossier" situé dans le
formulaire et dans l'Etat, soit par exemple "Réponse B22007-12-52MJK"?
Tous mes remerciements
AlainPDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
Bien entendu...
Le nom du fichier de sortie est représenté par une variable de type String...
Vous pouvez alors construire un nom de fichier tel que vous l'entendez ;
Par exemple :
Sub ImprimerPDF()
Const PREFIXE_FICHIER As String = "Réponse "
Dim strRéfDossier As String 'Ici = à B22007-12-52MJK
Dim strNomDuPDF As String
Dim strDossier As String
If IsNull(Me!strRéfDossier) Then
MsgBox "Vous devez préciser le N° de dossier avant de générer le PDF !",
48
Me!strRéfDossier.SetFocus
Exit Sub
Else
strDossier = Application.CurrentProject.Path & "PDF"
'Par exemple U:Développement
strNomDuPDF = strDossier & PREFIXE_FICHIER & strRéfDossier & ".pdf"
'Ici : Réponse B22007-12-52MJK.pdf
Call subCreatePDFFromReport("Votre état", strNomDuPDF)
End If
End Sub
Bon courage et bravo, vous avez réussi !!!
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Autant pour moi, j'avais oublié de supprimer certaines références dans
Microsoft Visual Basic - Outils - Références.
Maintenant ça marche et très bien; je produis bien un fichier Adobe Acrobat
Output.pdf dans le bon directory.
Je reviens à un eperfectionnement précisé dans ma première demande:
Est il possible de remplacer le nom Output.pdf, par un nom composé d'une
constante "Réponse" et d'un champ alpha variable "RéfDossier" situé dans le
formulaire et dans l'Etat, soit par exemple "Réponse B22007-12-52MJK"?
Tous mes remerciements
Alain
PDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
Bien entendu...
Le nom du fichier de sortie est représenté par une variable de type String...
Vous pouvez alors construire un nom de fichier tel que vous l'entendez ;
Par exemple :
Sub ImprimerPDF()
Const PREFIXE_FICHIER As String = "Réponse "
Dim strRéfDossier As String 'Ici = à B22007-12-52MJK
Dim strNomDuPDF As String
Dim strDossier As String
If IsNull(Me!strRéfDossier) Then
MsgBox "Vous devez préciser le N° de dossier avant de générer le PDF !",
48
Me!strRéfDossier.SetFocus
Exit Sub
Else
strDossier = Application.CurrentProject.Path & "PDF"
'Par exemple U:Développement
strNomDuPDF = strDossier & PREFIXE_FICHIER & strRéfDossier & ".pdf"
'Ici : Réponse B22007-12-52MJK.pdf
Call subCreatePDFFromReport("Votre état", strNomDuPDF)
End If
End Sub
Bon courage et bravo, vous avez réussi !!!
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )Autant pour moi, j'avais oublié de supprimer certaines références dans
Microsoft Visual Basic - Outils - Références.
Maintenant ça marche et très bien; je produis bien un fichier Adobe Acrobat
Output.pdf dans le bon directory.
Je reviens à un eperfectionnement précisé dans ma première demande:
Est il possible de remplacer le nom Output.pdf, par un nom composé d'une
constante "Réponse" et d'un champ alpha variable "RéfDossier" situé dans le
formulaire et dans l'Etat, soit par exemple "Réponse B22007-12-52MJK"?
Tous mes remerciements
AlainPDFWriter est l'élément indispensable au fonctionnement de cet exemple.
C'est d'ailleurs écrit dans le forum où il est hébergé.
Le conflit de version 4.0 / 6.0 peut être une gêne.
Il existe sinon des solutions gratuites de génération de PDF comme le
souligne Fabien dans le post qui suit mais dont le code peut être aussi
complexe...
Mais vous en trouverez aussi ailleurs.
La solution que je vous ai proposée n'a d'issue que si vous posséder une
installation unique de Acrobat.
Dans votre gestionnaire d'imprimantes, avez-vous une PDFDistiller ?
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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 SubQuelle erreur ais-je pu commettre ?
Au regard de ce que vous m'avez fourni, la procédure SubImprimerPDF()
n'existe pas dans votre code. Il vous faut la rédiger avec les paramètres
requis.
De plus, vous n'êtes pas obligé d'affecter le bouton à une macro mais à un
événement.
Par ailleurs, ne nommez pas vos modules avec des espaces.
Nommez les "basAdobePDF" et "basRegistre"
Je vous recommande la lecture de ce tuto :
http://argyronet.developpez.com/office/vba/convention/
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
Quelle erreur ais-je pu commettre ?
Au regard de ce que vous m'avez fourni, la procédure SubImprimerPDF()
n'existe pas dans votre code. Il vous faut la rédiger avec les paramètres
requis.
De plus, vous n'êtes pas obligé d'affecter le bouton à une macro mais à un
événement.
Par ailleurs, ne nommez pas vos modules avec des espaces.
Nommez les "basAdobePDF" et "basRegistre"
Je vous recommande la lecture de ce tuto :
http://argyronet.developpez.com/office/vba/convention/
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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 SubQuelle erreur ais-je pu commettre ?
Au regard de ce que vous m'avez fourni, la procédure SubImprimerPDF()
n'existe pas dans votre code. Il vous faut la rédiger avec les paramètres
requis.
De plus, vous n'êtes pas obligé d'affecter le bouton à une macro mais à un
événement.
Par ailleurs, ne nommez pas vos modules avec des espaces.
Nommez les "basAdobePDF" et "basRegistre"
Je vous recommande la lecture de ce tuto :
http://argyronet.developpez.com/office/vba/convention/
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Je reviens vers vous après avoir testé le processus d'Argyronet, qui
fonctionne, mais seulement sous Acrobat 4..0. je souhaite etster votre
méthode qui semble t il fonctinne sous Acrobat versions ultérieures.
j'ai téléchargé "A2000SnapshotToPDFver751" et transféré dynapdf.dll et
StrStorage.dll dans WindowsSystem32 folder en copiant collant.
Que faire par la suite, notamment dois-je importer les modules de
A2000SnapshotToPDFver751 dans ma base Access 2003? comment les personnaliser
pour imprimer un étét nommé "BenchMark" sous .pdf dans
U:DéveloppementBenchMark Client.pdf
Merci
AlainMerci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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 SubQuelle erreur ais-je pu commettre ?
Au regard de ce que vous m'avez fourni, la procédure SubImprimerPDF()
n'existe pas dans votre code. Il vous faut la rédiger avec les paramètres
requis.
De plus, vous n'êtes pas obligé d'affecter le bouton à une macro mais à un
événement.
Par ailleurs, ne nommez pas vos modules avec des espaces.
Nommez les "basAdobePDF" et "basRegistre"
Je vous recommande la lecture de ce tuto :
http://argyronet.developpez.com/office/vba/convention/
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Je reviens vers vous après avoir testé le processus d'Argyronet, qui
fonctionne, mais seulement sous Acrobat 4..0. je souhaite etster votre
méthode qui semble t il fonctinne sous Acrobat versions ultérieures.
j'ai téléchargé "A2000SnapshotToPDFver751" et transféré dynapdf.dll et
StrStorage.dll dans WindowsSystem32 folder en copiant collant.
Que faire par la suite, notamment dois-je importer les modules de
A2000SnapshotToPDFver751 dans ma base Access 2003? comment les personnaliser
pour imprimer un étét nommé "BenchMark" sous .pdf dans
U:DéveloppementBenchMark Client.pdf
Merci
Alain
Merci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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
Quelle erreur ais-je pu commettre ?
Au regard de ce que vous m'avez fourni, la procédure SubImprimerPDF()
n'existe pas dans votre code. Il vous faut la rédiger avec les paramètres
requis.
De plus, vous n'êtes pas obligé d'affecter le bouton à une macro mais à un
événement.
Par ailleurs, ne nommez pas vos modules avec des espaces.
Nommez les "basAdobePDF" et "basRegistre"
Je vous recommande la lecture de ce tuto :
http://argyronet.developpez.com/office/vba/convention/
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Je reviens vers vous après avoir testé le processus d'Argyronet, qui
fonctionne, mais seulement sous Acrobat 4..0. je souhaite etster votre
méthode qui semble t il fonctinne sous Acrobat versions ultérieures.
j'ai téléchargé "A2000SnapshotToPDFver751" et transféré dynapdf.dll et
StrStorage.dll dans WindowsSystem32 folder en copiant collant.
Que faire par la suite, notamment dois-je importer les modules de
A2000SnapshotToPDFver751 dans ma base Access 2003? comment les personnaliser
pour imprimer un étét nommé "BenchMark" sous .pdf dans
U:DéveloppementBenchMark Client.pdf
Merci
AlainMerci de votre réponse. Malheureusement j’ai encore besoin de vos lumières et
vous remercie par avance de vos conseils:
En effet, lorsque je click sur le bouton du formulaire « Fiche Intermédiaire
» (sur lequel se situe le bouton dont le nom dans la feuille de propriété est
« btncreerPDF »), l’état « Etat » est imprimé par l’imprimante papier au lieu
de s’imprimer sur un document PDF appelé OutputClient.pdf.
1. Dans le module « Form_Fiche Intermédiaire » sur lequel se situe le
bouton qui doit déclencher l’impression d’ « Etat » dans le document PDF «
OutputClient.pdf » et dont le nom dans la feuille de propriété est «
btncreerPDF » je dispose de la procédure suivante
Private Sub btncreerPDF_click()
subCreatePDFFromReport "Etat", "U:DéveloppementOutputClient.pdf"
End Sub
2. J’ai réinstallé Adobe Acrobat 6.0 Professional avec toutes les fonctions
exécutables depuis le disque dur. En fait dans le menu d’installation d’Adobe
4.0, il y a bien une référence à PDFWriter. Mais l’installation d’Adobe
Acrobat Professional (Mise à jour) demande de supprimer Adobe 4.0 et
réinstalle Adobe 6.0 afin de ne pas laisser coexister deux versions. . Dans
le menu d’installation je n’ai trouvé aucune référence à PDFWriter. Dans le
menu de choix de l’imprimante d’Access, l’imprimante est désignée sous le nom
d’ « Adobe PDF ».
3.. J’ai vérifié les lignes cochées dans le menu Microsoft Visual Basic –
Outils – Références :
• Visual Basic for Applications
• Microsoft Access 11.0 Objects library
• OLE automation
• Microsoft DAO 3.6 Objects library
• Microsoft Actiive X Data Objects 2.5 Library
• Microsoft Forms 2.0 Objects Library
• Microsoft Word 11.0 Objects library
• Acrobat Distiller
• Acrobat PDFMakerX
• Acrobat Access 2.0 Type Library
• Adobe Acrobat 6.0 Type Library
Dois-je sélectionner des lignes supplémentaires ?
4. Je joins par ailleurs les deux modules que vous avez développés tels
qu’ils sont actuellement dans ma base :
BasAdobePDF
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
Public Sub subCreatePDFFromReport(ByVal ReportName As String, _
ByVal PDFFileName As String)
originalPrinter = fnctGetDefaultPrinter()
SetDefaultPrinter "Acrobat PDFWriter"
subRegistrySetKeyValue rootHKeyCurrentUser, _
"SoftwareAdobeAcrobat PDFWriter", "PDFFileName", _
PDFFileName, RRKREGSZ
DoCmd.OpenReport ReportName, 0
SetDefaultPrinter originalPrinter
End Sub
Private Sub ImprimerPDF()
subCreatePDFFromReport "", "U:DéveloppementOutputClient.pdf"
End Sub
BasRegistre
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 SubQuelle erreur ais-je pu commettre ?
Au regard de ce que vous m'avez fourni, la procédure SubImprimerPDF()
n'existe pas dans votre code. Il vous faut la rédiger avec les paramètres
requis.
De plus, vous n'êtes pas obligé d'affecter le bouton à une macro mais à un
événement.
Par ailleurs, ne nommez pas vos modules avec des espaces.
Nommez les "basAdobePDF" et "basRegistre"
Je vous recommande la lecture de ce tuto :
http://argyronet.developpez.com/office/vba/convention/
--
Argy
http://argyronet.developpez.com/
Créez des programmes avec Microsoft Access 2007 (ISBN-2742982442 )
Bonjour Alain
Voici comment j'utilise cette fonction
Private Sub Envoi_tableau_Click()
Dim StrSQl, stDocName, Fichier_Sortie As String
Dim Db As DAO.Database
Dim Ok_Pdf As Boolean
Set Db = CurrentDb
Sauve_enreg
stDocName = "Tournois"
On Error Resume Next
'supprimer le fichier s'il existe
Fichier_Sortie = "c:" & Me.Titre & ".pdf"
Kill "c:" & Me.Titre & ".pdf"
'On créé la requete qui doit alimenter l'état tournois
StrSQl = "SELECT Tournois.*, Cout.[1], Cout.[2], Cout.[3],
Cout.Cout1, Cout.[Cout 2], Cout.Nbr_Sup, Cout.[Cout Sup], Cout.Cout3 "
StrSQl = StrSQl & "FROM Tournois INNER JOIN Cout ON Tournois.N° =
Cout.N° "
'On enregistre la nouvelle requete qui alimente l'etat
Db.CreateQueryDef("Cout Tournois").SQL= StrSQl & "WHERE
(((Tournois.N°)=" & Me.N° & "));")
Ca marchera mieux avec :
'On convertit l'état en pdf
Ok_Pdf = ConvertReportToPDF(stDocName, , Fichier_Sortie, False, False)
If Not Ok_Pdf Then MsgBox "Erreur lors de la création du fichier PDF"
'et on en remet la requete a l'etat neutre
Db.CreateQueryDef("Cout Tournois").sql= StrSQl & ";"
et
Set Db = Nothing
'On ouvre le formulaire pour l'envoi du PDF
DoCmd.OpenForm "Envoi Tournoi", acNormal, , , , acDialog
End Sub
Le module ModReportToPdf doit être importé dans la base.
Dans ma procédure je génére dynamiquement la requete qui alimente l'état
car Lebans passe par une 1er étape qui exporte le rapport en un fichier
snapshot donc on ne peut pas appliquer de filtre lors de cette exportation.
@+
Fabien
Bonjour Alain
Voici comment j'utilise cette fonction
Private Sub Envoi_tableau_Click()
Dim StrSQl, stDocName, Fichier_Sortie As String
Dim Db As DAO.Database
Dim Ok_Pdf As Boolean
Set Db = CurrentDb
Sauve_enreg
stDocName = "Tournois"
On Error Resume Next
'supprimer le fichier s'il existe
Fichier_Sortie = "c:" & Me.Titre & ".pdf"
Kill "c:" & Me.Titre & ".pdf"
'On créé la requete qui doit alimenter l'état tournois
StrSQl = "SELECT Tournois.*, Cout.[1], Cout.[2], Cout.[3],
Cout.Cout1, Cout.[Cout 2], Cout.Nbr_Sup, Cout.[Cout Sup], Cout.Cout3 "
StrSQl = StrSQl & "FROM Tournois INNER JOIN Cout ON Tournois.N° =
Cout.N° "
'On enregistre la nouvelle requete qui alimente l'etat
Db.CreateQueryDef("Cout Tournois").SQL= StrSQl & "WHERE
(((Tournois.N°)=" & Me.N° & "));")
Ca marchera mieux avec :
'On convertit l'état en pdf
Ok_Pdf = ConvertReportToPDF(stDocName, , Fichier_Sortie, False, False)
If Not Ok_Pdf Then MsgBox "Erreur lors de la création du fichier PDF"
'et on en remet la requete a l'etat neutre
Db.CreateQueryDef("Cout Tournois").sql= StrSQl & ";"
et
Set Db = Nothing
'On ouvre le formulaire pour l'envoi du PDF
DoCmd.OpenForm "Envoi Tournoi", acNormal, , , , acDialog
End Sub
Le module ModReportToPdf doit être importé dans la base.
Dans ma procédure je génére dynamiquement la requete qui alimente l'état
car Lebans passe par une 1er étape qui exporte le rapport en un fichier
snapshot donc on ne peut pas appliquer de filtre lors de cette exportation.
@+
Fabien
Bonjour Alain
Voici comment j'utilise cette fonction
Private Sub Envoi_tableau_Click()
Dim StrSQl, stDocName, Fichier_Sortie As String
Dim Db As DAO.Database
Dim Ok_Pdf As Boolean
Set Db = CurrentDb
Sauve_enreg
stDocName = "Tournois"
On Error Resume Next
'supprimer le fichier s'il existe
Fichier_Sortie = "c:" & Me.Titre & ".pdf"
Kill "c:" & Me.Titre & ".pdf"
'On créé la requete qui doit alimenter l'état tournois
StrSQl = "SELECT Tournois.*, Cout.[1], Cout.[2], Cout.[3],
Cout.Cout1, Cout.[Cout 2], Cout.Nbr_Sup, Cout.[Cout Sup], Cout.Cout3 "
StrSQl = StrSQl & "FROM Tournois INNER JOIN Cout ON Tournois.N° =
Cout.N° "
'On enregistre la nouvelle requete qui alimente l'etat
Db.CreateQueryDef("Cout Tournois").SQL= StrSQl & "WHERE
(((Tournois.N°)=" & Me.N° & "));")
Ca marchera mieux avec :
'On convertit l'état en pdf
Ok_Pdf = ConvertReportToPDF(stDocName, , Fichier_Sortie, False, False)
If Not Ok_Pdf Then MsgBox "Erreur lors de la création du fichier PDF"
'et on en remet la requete a l'etat neutre
Db.CreateQueryDef("Cout Tournois").sql= StrSQl & ";"
et
Set Db = Nothing
'On ouvre le formulaire pour l'envoi du PDF
DoCmd.OpenForm "Envoi Tournoi", acNormal, , , , acDialog
End Sub
Le module ModReportToPdf doit être importé dans la base.
Dans ma procédure je génére dynamiquement la requete qui alimente l'état
car Lebans passe par une 1er étape qui exporte le rapport en un fichier
snapshot donc on ne peut pas appliquer de filtre lors de cette exportation.
@+
Fabien
