'lut
Moi aussi, je l'ai cherché pendant longtemps:
A mettre dans 1 module
' *** Début du module Impression ***
Type ch_DEVMODE
RGB As String * 94
End Type
Type type_DEVMODE
chNomPériphérique As String * 16
entSpécVersion As Integer
entVersionGestionnaire As Integer
entTaille As Integer
entExtraGestionnaire As Integer
lngChamps As Long
entOrientation As Integer
entTaillePapier As Integer
entLongueurPapier As Integer
entLargeurPapier As Integer
entEchelle As Integer
entCopies As Integer
entSourceDéfaut As Integer
entQualitéImpression As Integer
entCouleur As Integer
entRectoverso As Integer
entResolution As Integer
entOptionTT As Integer
entAssembler As Integer
entNomFormulaire As String * 16
lngPad As Long
lngBits As Long
lngPW As Long
lngPH As Long
lngDFI As Long
lngDFr As Long
End Type
Type ch_PRTMIP
chRGB As String * 28
End Type
Type type_PRTMIP
entMargeGauche As Long
entMargeHaut As Long
entMargeDroite As Long
entMargeBas As Long
entDonnéesSeulement As Long
entLargeur As Long
entHauteur As Long
entTailleDesEléments As Long
entColonnes As Long
entEspacementDeColonnes As Long
entEspacementDeLignes As Long
entDisposition As Long
entImpressionRapide As Long
entFeuilleDeDonnées As Long
End Type
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Sub AfficherRapportZoom(txtNom As String, entZoom As Integer)
' Afficher un rapport en spécifiant le zoom en pleine écran
' paramètres : 1- le nom du rapport en texte
' 2- le zoom (0, 10,25,50,75,100,150 ou 200)
' exemple : AfficherRapportZoom "Contacts", 75
' note : zoom 0 pour ajuster le contenu à la fenêtre
DoCmd.OpenReport txtNom, acViewPreview
Select Case entZoom
Case 0: DoCmd.RunCommand acCmdFitToWindow
Case 10: DoCmd.RunCommand acCmdZoom10
Case 25: DoCmd.RunCommand acCmdZoom25
Case 50: DoCmd.RunCommand acCmdZoom50
Case 75: DoCmd.RunCommand acCmdZoom75
Case 100: DoCmd.RunCommand acCmdZoom100
Case 150: DoCmd.RunCommand acCmdZoom150
Case 200: DoCmd.RunCommand acCmdZoom200
Case Else: DoCmd.RunCommand acCmdZoom100
End Select
DoCmd.Maximize
End Sub
Public Sub ModifierMarges(txtNom As String, lngHaut As Long, lngBas As Long, lngGauche As Long, lngDroite As Long)
' Modifier les marges d'un rapport avant de l'imprimer
' paramètres : 1- le nom du rapport en texte
' 2- la marge du haut en cm
' 3- la marge du bas en cm
' 4- la marge du gauche en cm
' 5- la marge du droite en cm
' exemple : ModifierMarges "Contacts", 1, 1, 1.5, 1.5
' DoCmd.OpenReport "Contacts", acViewPreview
Dim ChaînePrtMip As ch_PRTMIP
Dim PM As type_PRTMIP
Dim rpt As Report
DoCmd.OpenReport txtNom, acDesign ' Ouvre l'état en mode Création.
Set rpt = Reports(txtNom)
ChaînePrtMip.chRGB = rpt.PrtMip
LSet PM = ChaînePrtMip
PM.entMargeHaut = lngHaut * 567 ' Définit les marges.
PM.entMargeBas = lngBas * 567
PM.entMargeGauche = lngGauche * 567
PM.entMargeDroite = lngDroite * 567
LSet ChaînePrtMip = PM ' Met à jour la propriété.
rpt.PrtMip = ChaînePrtMip.chRGB
DoCmd.Save
End Sub
Public Sub ModifierOrientation(txtNom As String, entOrientation As Integer)
' Modifier l'orientation du papier avant d'imprimer
' paramètres : 1- le nom du rapport en texte
' 2- l'orientation du papier (1 Portrait, 2 Paysage)
' exemple : ModifierOrientation "Contacts", 2
' DoCmd.OpenReport "Contacts", acViewPreview
Dim ChaînePér As ch_DEVMODE
Dim DM As type_DEVMODE
Dim chExtraModPér As String
Dim rpt As Report
DoCmd.OpenReport txtNom, acDesign ' Ouvre l'état en mode Création.
Set rpt = Reports(txtNom)
If Not IsNull(rpt.PrtDevMode) Then
chExtraModPér = rpt.PrtDevMode
ChaînePér.RGB = chExtraModPér
LSet DM = ChaînePér
DM.entOrientation = entOrientation
LSet ChaînePér = DM ' Met à jour la propriété.
Mid(chExtraModPér, 1, 94) = ChaînePér.RGB
rpt.PrtDevMode = chExtraModPér
End If
DoCmd.Save
End Sub
Public Sub ModifierTaillePapierPers(txtNom As String, sngLargeur As Single, sngLongueur As Single)
' Modifier la taille du papier personnalisée d'un rapport avant de l'imprimer
' paramètres : 1- le nom du rapport en texte
' 2- la largeur du papier en cm
' 3- la longueur du papier en cm
' exemple : ModifierTaillePapierPers "Contacts", 10, 10
' DoCmd.OpenReport "Contacts", acViewPreview
Dim ChaînePér As ch_DEVMODE
Dim DM As type_DEVMODE
Dim chExtraModPér As String
Dim rpt As Report
DoCmd.OpenReport txtNom, acDesign ' Ouvre l'état en mode Création.
Set rpt = Reports(txtNom)
If Not IsNull(rpt.PrtDevMode) Then
chExtraModPér = rpt.PrtDevMode ' Lit la structure DEVMODE en cours.
ChaînePér.RGB = chExtraModPér
LSet DM = ChaînePér
DM.lngChamps = DM.lngChamps Or DM.entTaillePapier Or DM.entLongueurPapier _
Or DM.entLargeurPapier
DM.entOrientation = 1
DM.entTaillePapier = 256 ' Définit la page personnalisée.
DM.entLargeurPapier = Int(sngLargeur * 100)
DM.entLongueurPapier = Int(sngLongueur * 100)
LSet ChaînePér = DM ' Met à jour la propriété.
Mid(chExtraModPér, 1, 94) = ChaînePér.RGB
rpt.PrtDevMode = chExtraModPér
End If
DoCmd.Save
End Sub
:clown) BasicInstinct