C'est une petite classe qui permet d'imprimer en toute simplicité : on spécifie quel élément va être placé à quel endroit, et on a plus qu'à lancer l'impression.
Le code n'est pas encore complet...
Source / Exemple :
Option Explicit
Private ImgApp As PictureBox
Private PrinterObj As Object
Private Doc() As ListDoc
Private DocElemCount As Long
Private PageNum As Integer
'Donnée élementaire de base
Private Type ListDoc
T As Typ
s As String
x As Double
y As Double
X2 As Double
Y2 As Double
FntName As String
fntSize As Byte
FntU As Boolean
FntI As Boolean
FntB As Boolean
CenterH As Aligne
CenterV As AligneV
ForeColor As Long
BackColor As Long
End Type
'Type d'élement possibles
Private Enum Typ
Texte = 1
Boite = 2
Cercle = 3
Image = 4
Point = 5
Ligne = 6
NouvellePage = 7
OrientationPortrait = 8
OrientationPaysage = 9
End Enum
'Alignement horizontal
Public Enum Aligne
Gauche = 1
Milieu = 2
Droite = 3
End Enum
'Alignement vertical
Public Enum AligneV
Haut = 1
Centre = 2
Bas = 3
End Enum
'variables locales de stockage des valeurs de propriétés
Private mvarLastTextElementWidth As Double 'copie locale
Private mvarLastTextElementHeight As Double 'copie locale
Public Property Let LastTextElementHeight(ByVal vData As Double)
mvarLastTextElementHeight = vData
End Property
Public Property Get LastTextElementHeight() As Double
LastTextElementHeight = mvarLastTextElementHeight
End Property
Public Property Let LastTextElementWidth(ByVal vData As Double)
mvarLastTextElementWidth = vData
End Property
Public Property Get LastTextElementWidth() As Double
LastTextElementWidth = mvarLastTextElementWidth
End Property
Public Function AddTextXY(ByVal Txt As String, ByVal x As Double, ByVal y As Double, Optional ByVal CentreH As Aligne = Gauche, Optional ByVal CentreV As AligneV = Haut, Optional ByVal ForeColor As Long = vbBlack, Optional ByVal Bold As Boolean = False, Optional ByVal Italic As Boolean = False, Optional ByVal UnderLine As Boolean = False, Optional ByVal FontSize As Byte = 10, Optional ByVal BackColor As Long = vbWhite) As Long
'Ajoute un élément texte dans le buffer
DocElemCount = DocElemCount + 1
ReDim Preserve Doc(DocElemCount)
Doc(DocElemCount).T = Texte
Doc(DocElemCount).s = Txt
Doc(DocElemCount).x = x
Doc(DocElemCount).y = y
Doc(DocElemCount).CenterH = CentreH
Doc(DocElemCount).CenterV = CentreV
Doc(DocElemCount).ForeColor = ForeColor
Doc(DocElemCount).BackColor = BackColor
Doc(DocElemCount).FntB = Bold
Doc(DocElemCount).FntU = UnderLine
Doc(DocElemCount).FntI = Italic
Doc(DocElemCount).fntSize = FontSize
Printer.FontSize = IIf(FontSize <= 0, 1, FontSize)
Printer.FontBold = Bold
Printer.FontItalic = Italic
Printer.FontUnderline = UnderLine
If Me.NumberOfPrinters > 0 Then
mvarLastTextElementWidth = Printer.TextWidth(Txt)
mvarLastTextElementHeight = Printer.TextHeight(Txt)
End If
AddTextXY = DocElemCount
End Function
Public Function GetTextWidth(ByVal Txt As String, Optional ByVal Bold As Boolean = False, Optional ByVal Italic As Boolean = False, Optional ByVal UnderLine As Boolean = False, Optional ByVal FontSize As Byte = 10) As Double
If Me.NumberOfPrinters > 0 Then
Printer.FontSize = FontSize
Printer.FontBold = Bold
Printer.FontItalic = Italic
Printer.FontUnderline = UnderLine
GetTextWidth = Printer.TextWidth(Txt)
End If
End Function
Public Function GetTextHeight(ByVal Txt As String, Optional ByVal Bold As Boolean = False, Optional ByVal Italic As Boolean = False, Optional ByVal UnderLine As Boolean = False, Optional ByVal FontSize As Byte = 10) As Double
If Me.NumberOfPrinters > 0 Then
Printer.FontSize = IIf(FontSize <= 0, 1, FontSize)
Printer.FontBold = Bold
Printer.FontItalic = Italic
Printer.FontUnderline = UnderLine
GetTextHeight = Printer.TextHeight(Txt)
End If
End Function
Public Function CreateDocument() As Boolean
'Efface le buffer
DocElemCount = 0
ReDim Doc(DocElemCount)
CreateDocument = True
PageNum = 1
If Me.NumberOfPrinters > 0 Then
Printer.ScaleMode = vbMillimeters
End If
End Function
Public Function GenePrintOut(ByVal NombreDeCopies As Byte) As Boolean
'Lance l'impression du buffer dans l'objet correspondant
Dim x As Double, y As Double, A As Integer
If DocElemCount > 0 Then
'Paramètres par défaut du style d'impression
Printer.Copies = NombreDeCopies
Printer.ScaleMode = vbMillimeters
Printer.FillStyle = vbFSSolid
For A = 1 To DocElemCount
Printer.ForeColor = Doc(A).ForeColor
Printer.FillColor = Doc(A).BackColor
Select Case Doc(A).T
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Texte
'Centrage horizontal
x = Doc(A).x
If Doc(A).CenterH = Droite Then x = x - Me.GetTextWidth(Doc(A).s, Doc(A).FntB, Doc(A).FntI, Doc(A).FntU, Doc(A).fntSize)
If Doc(A).CenterH = Milieu Then x = x - Me.GetTextWidth(Doc(A).s, Doc(A).FntB, Doc(A).FntI, Doc(A).FntU, Doc(A).fntSize) / 2
Printer.CurrentX = x
'Centrage vertical
y = Doc(A).y
If Doc(A).CenterV = Bas Then y = y - Me.GetTextHeight(Doc(A).s, Doc(A).FntB, Doc(A).FntI, Doc(A).FntU, Doc(A).fntSize)
If Doc(A).CenterV = Centre Then y = y - Me.GetTextHeight(Doc(A).s, Doc(A).FntB, Doc(A).FntI, Doc(A).FntU, Doc(A).fntSize) / 2
Printer.CurrentY = y
'Mise en forme
Printer.FontBold = Doc(A).FntB
Printer.FontItalic = Doc(A).FntI
Printer.FontUnderline = Doc(A).FntU
Printer.FontSize = IIf(Doc(A).fntSize <= 0, 1, Doc(A).fntSize)
Printer.Print Doc(A).s
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Boite
Printer.Line (Doc(A).x, Doc(A).y)-Step(Doc(A).X2, Doc(A).Y2), , B
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Cercle
Printer.Circle (Doc(A).x, Doc(A).y), Doc(A).X2
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Image
If Doc(A).X2 > -1 Or Doc(A).Y2 > -1 Then
Printer.PaintPicture LoadPicture(Doc(A).s), Doc(A).x, Doc(A).y, Doc(A).X2, Doc(A).Y2
Else
Printer.PaintPicture LoadPicture(Doc(A).s), Doc(A).x, Doc(A).y
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Point
Printer.PSet (Doc(A).x, Doc(A).y), Doc(A).X2
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Ligne
Printer.Line (Doc(A).x, Doc(A).y)-Step(Doc(A).X2, Doc(A).Y2), Doc(A).ForeColor
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case NouvellePage
Printer.NewPage
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case OrientationPortrait
Printer.Orientation = vbPRORPortrait
Printer.FontTransparent = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case OrientationPaysage
Printer.Orientation = vbPRORLandscape
Printer.FontTransparent = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Else
End Select
Next A
Printer.EndDoc
End If
End Function
Public Function DrawBox(ByVal x As Double, ByVal y As Double, ByVal Width As Double, ByVal Height As Double, Optional ForeColor As Long = vbBlack, Optional BackColor As Long = vbWhite) As Long
'Ajoute une boite colorée
DocElemCount = DocElemCount + 1
ReDim Preserve Doc(DocElemCount)
Doc(DocElemCount).T = Boite
Doc(DocElemCount).x = x
Doc(DocElemCount).y = y
Doc(DocElemCount).X2 = Width
Doc(DocElemCount).Y2 = Height
Doc(DocElemCount).ForeColor = ForeColor
Doc(DocElemCount).BackColor = BackColor
DrawBox = DocElemCount
End Function
Public Function DrawCircle(ByVal x As Double, ByVal y As Double, ByVal Radius As Double, Optional ForeColor As Long = vbBlack, Optional BackColor As Long = vbWhite) As Long
'Ajoute un cercle
DocElemCount = DocElemCount + 1
ReDim Preserve Doc(DocElemCount)
Doc(DocElemCount).T = Cercle
Doc(DocElemCount).x = x
Doc(DocElemCount).y = y
Doc(DocElemCount).X2 = Radius
Doc(DocElemCount).ForeColor = ForeColor
Doc(DocElemCount).BackColor = BackColor
DrawCircle = DocElemCount
End Function
Public Function DrawPicture(ByVal Picture As String, ByVal x As Double, ByVal y As Double, Optional ByVal Width As Double = -1, Optional Height As Double = -1) As Long
'Ajoute une image
DocElemCount = DocElemCount + 1
ReDim Preserve Doc(DocElemCount)
Doc(DocElemCount).T = Image
Doc(DocElemCount).s = Picture
Doc(DocElemCount).x = x
Doc(DocElemCount).y = y
Doc(DocElemCount).X2 = Width
Doc(DocElemCount).Y2 = Height
DrawPicture = DocElemCount
End Function
Public Function DrawPoint(ByVal x As Double, ByVal y As Double, Optional ByVal Color As Long = vbBlack) As Long
DocElemCount = DocElemCount + 1
ReDim Preserve Doc(DocElemCount)
Doc(DocElemCount).T = Point
Doc(DocElemCount).x = x
Doc(DocElemCount).y = y
Doc(DocElemCount).ForeColor = Color
DrawPoint = DocElemCount
End Function
Public Function PrinterAreaWidth() As Double
If Me.NumberOfPrinters > 0 Then
PrinterAreaWidth = Printer.ScaleWidth
End If
End Function
Public Function PrinterAreaHeight() As Double
If Me.NumberOfPrinters > 0 Then
PrinterAreaHeight = Printer.ScaleHeight
End If
End Function
Public Function GetPageNum() As Double
GetPageNum = PageNum
End Function
Public Function DrawLine(ByVal x As Double, ByVal y As Double, ByVal X2 As Double, ByVal Y2 As Double, Optional ForeColor As Long = vbBlack) As Long
'Ajoute une ligne colorée
DocElemCount = DocElemCount + 1
ReDim Preserve Doc(DocElemCount)
Doc(DocElemCount).T = Ligne
Doc(DocElemCount).x = x
Doc(DocElemCount).y = y
Doc(DocElemCount).X2 = X2
Doc(DocElemCount).Y2 = Y2
Doc(DocElemCount).ForeColor = ForeColor
DrawLine = DocElemCount
End Function
Public Function NewPage() As Double
DocElemCount = DocElemCount + 1
ReDim Preserve Doc(DocElemCount)
Doc(DocElemCount).T = NouvellePage
PageNum = PageNum + 1
End Function
Private Sub Class_Initialize()
Me.CreateDocument
End Sub
Public Function GetNumPages() As Integer
GetNumPages = PageNum
End Function
Public Function SetPortrait() As Double
DocElemCount = DocElemCount + 1
ReDim Preserve Doc(DocElemCount)
Doc(DocElemCount).T = OrientationPortrait
SetPortrait = DocElemCount
If Me.NumberOfPrinters > 0 Then
Printer.Orientation = vbPRORPortrait
End If
End Function
Public Function SetPaysage() As Double
DocElemCount = DocElemCount + 1
ReDim Preserve Doc(DocElemCount)
Doc(DocElemCount).T = OrientationPaysage
SetPaysage = DocElemCount
If Me.NumberOfPrinters > 0 Then
Printer.Orientation = vbPRORLandscape
End If
End Function
Public Function GeneApercu(ByRef Ctrl As PictureBox, Optional Zoom As Double = 100) As Boolean
'Lance l'impression du buffer dans l'objet correspondant
Dim x As Double, y As Double, A As Integer, Z As Double
Z = Zoom / 100
If DocElemCount > 0 Then
With Ctrl
'Paramètres par défaut du style d'impression
'.Copies = NombreDeCopies
.Cls
.ScaleMode = vbMillimeters
.FillStyle = vbFSSolid
.FontTransparent = True
For A = 1 To DocElemCount
.ForeColor = Doc(A).ForeColor
.FillColor = Doc(A).BackColor
Select Case Doc(A).T
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Texte
'Centrage horizontal
x = Doc(A).x
If Doc(A).CenterH = Droite Then x = x - .TextWidth(Doc(A).s)
If Doc(A).CenterH = Milieu Then x = x - .TextWidth(Doc(A).s) / 2
.CurrentX = x * Z
'Centrage vertical
y = Doc(A).y
If Doc(A).CenterV = Bas Then y = y - .TextHeight(Doc(A).s)
If Doc(A).CenterV = Centre Then y = y - .TextHeight(Doc(A).s) / 2
.CurrentY = y * Z
'Mise en forme
.FontBold = Doc(A).FntB
.FontItalic = Doc(A).FntI
.FontUnderline = Doc(A).FntU
.FontSize = Doc(A).fntSize * Z
Ctrl.Print Doc(A).s
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Boite
Ctrl.Line (Doc(A).x * Z, Doc(A).y * Z)-Step(Doc(A).X2 * Z, Doc(A).Y2 * Z), , B
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Cercle
Ctrl.Circle (Doc(A).x * Z, Doc(A).y * Z), Doc(A).X2 * Z
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Image
If Doc(A).X2 > -1 Or Doc(A).Y2 > -1 Then
.PaintPicture LoadPicture(Doc(A).s), Doc(A).x * Z, Doc(A).y * Z, Doc(A).X2 * Z, Doc(A).Y2 * Z
Else
.PaintPicture LoadPicture(Doc(A).s), Doc(A).x * Z, Doc(A).y * Z
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Point
Ctrl.PSet (Doc(A).x * Z, Doc(A).y * Z)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Ligne
Ctrl.Line (Doc(A).x * Z, Doc(A).y * Z)-Step(Doc(A).X2 * Z, Doc(A).Y2 * Z), Doc(A).ForeColor
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case NouvellePage
'non géré ici
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case OrientationPortrait
'non géré ici
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case OrientationPaysage
'non géré ici
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Else
End Select
Next A
End With
End If
End Function
Public Function NumberOfPrinters() As Integer
NumberOfPrinters = Printers.Count
End Function
Conclusion :
Hésitez pas pour les critiques contructives...
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.