Classe d'impression de tableaux
Contenu du snippet
C'est une classe qui permet d'imprimer un tableau facilement.
Cette classe utilise la classe d'impression que j'ai faite : http://www.vbfrance.com/code.aspx?ID=24177
Le principe : on définit les colonnes, le titre du tableau, et on ajoute les éléments, case par cases, de gauche à droite, et de haut en bas. Cette classe gère automatiquement les sauts de page.
Source / Exemple :
Option Explicit
Private Const MargeHaut As Double = 10
Private Const MargeGauche As Double = 10
Private NbrColonnes As Byte
Private Dimensions() As Double
Private L() As T_Cellule
Private Entete() As T_Cellule
Private CurrentX As Integer
Private CurrentY As Integer
Private NbrPages As Integer
Private TitrePremierePage As T_Cellule
Private Type T_Cellule
Contenu As String
BackColor As Long
ForeColor As Long
BorderColor As Long
Bold As Boolean
Italic As Boolean
UnderLine As Boolean
FontSize As Byte
CentreH As Aligne
CentreV As AligneV
End Type
'Public Enum Orientation
' Portrait
' Paysage
'End Enum
Private mvarOrientation As PrinterOrientationConstants
Public Property Let Orientation(ByVal vData As PrinterOrientationConstants)
mvarOrientation = vData
End Property
Public Property Get Orientation() As PrinterOrientationConstants
Orientation = mvarOrientation
End Property
Public Function GenePrintOut(ByRef PrintMachine As PrnMachine, ByVal NombreDeCopies As Byte) As Boolean
Dim I As Integer, J As Integer, H As Double, W As Double, MaxHeight As Double, ET As Boolean, x As Double, y As Double, N As String, TmpMaxHeight As Double, Portrait As Boolean
H = MargeHaut: ET = False: W = MargeGauche
PrintMachine.CreateDocument
If mvarOrientation = cdlLandscape Then
PrintMachine.SetPaysage
Portrait = False
Else
PrintMachine.SetPortrait
Portrait = True
End If
'Rendu
If TitrePremierePage.CentreH = Gauche Then x = W
If TitrePremierePage.CentreH = Milieu Then x = (PrintMachine.PrinterAreaWidth - 2 * W) / 2
If TitrePremierePage.CentreH = Droite Then x = PrintMachine.PrinterAreaWidth - W
PrintMachine.AddTextXY TitrePremierePage.Contenu, x, H, TitrePremierePage.CentreH, TitrePremierePage.CentreV, TitrePremierePage.ForeColor, TitrePremierePage.Bold, TitrePremierePage.Italic, TitrePremierePage.UnderLine, TitrePremierePage.FontSize
H = H + PrintMachine.LastTextElementHeight + 2
For I = 1 To CurrentY
MaxHeight = 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Si le rendu des en-têtes de colonnes n'ont pas été fait, le faire
If Not ET Then
'Détection de la hauteur la plus grande
For J = 1 To NbrColonnes
If PrintMachine.GetTextHeight(Entete(J).Contenu, Entete(J).Bold, Entete(J).Italic, Entete(J).UnderLine, Entete(J).FontSize) > MaxHeight Then
MaxHeight = PrintMachine.GetTextHeight(Entete(J).Contenu, Entete(J).Bold, Entete(J).Italic, Entete(J).UnderLine, Entete(J).FontSize)
End If
Next J
For J = 1 To NbrColonnes
PrintMachine.DrawBox W, H, Dimensions(J), MaxHeight + 1, Entete(J).BorderColor, Entete(J).BackColor
Select Case Entete(J).CentreH
Case Droite
x = W + Dimensions(J) - 0.5
Case Centre
x = W + Dimensions(J) / 2
Case Else
x = W + 0.5
End Select
Select Case Entete(J).CentreV
Case Bas
y = H + MaxHeight - 0.5
Case Centre
y = H + MaxHeight / 2
Case Else
y = H + 0.5
End Select
PrintMachine.AddTextXY Entete(J).Contenu, x, y, Entete(J).CentreH, Entete(J).CentreV, Entete(J).ForeColor, Entete(J).Bold, Entete(J).Italic, Entete(J).UnderLine, Entete(J).FontSize
W = W + Dimensions(J)
Next J
'Nouvelle ligne
H = H + MaxHeight + 1
W = MargeGauche
ET = True
'Ecriture du numéro de page
N = "Page : " & PrintMachine.GetPageNum
PrintMachine.DrawBox MargeGauche, PrintMachine.PrinterAreaHeight - PrintMachine.GetTextHeight(N, , , , 8) - 3, PrintMachine.GetTextWidth(N, , , , 8) + 2, PrintMachine.GetTextHeight(N, , , , 8) + 2
PrintMachine.AddTextXY N, 11, PrintMachine.PrinterAreaHeight - PrintMachine.GetTextHeight(N, , , , 8) - 3 + 1, , , , , , , 8
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MaxHeight = 0
'Pour chaque ligne, détection de la hauteur la plus grande
For J = 1 To NbrColonnes
With L(J, I)
TmpMaxHeight = PrintMachine.GetTextHeight(.Contenu, .Bold, .Italic, .UnderLine, .FontSize)
If TmpMaxHeight > MaxHeight Then
MaxHeight = TmpMaxHeight
End If
End With
Next J
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Détection de changement de pages
If H + MaxHeight + 2 * MargeHaut > PrintMachine.PrinterAreaHeight Then
ET = False
I = I - 1
H = MargeHaut
PrintMachine.NewPage
Else
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Rendu d'une ligne
For J = 1 To NbrColonnes
With L(J, I)
PrintMachine.DrawBox W, H, Dimensions(J), MaxHeight + 1, .BorderColor, .BackColor
Select Case .CentreH
Case Droite
x = W + Dimensions(J) - 0.5
Case Centre
x = W + Dimensions(J) / 2
Case Else
x = W + 0.5
End Select
Select Case .CentreV
Case Bas
y = H + MaxHeight - 0.5
Case Centre
y = H + MaxHeight / 2
Case Else
y = H + 0.5
End Select
PrintMachine.AddTextXY .Contenu, _
x, _
y, _
.CentreH, _
.CentreV, _
.ForeColor, _
.Bold, _
.Italic, _
.UnderLine, _
.FontSize
W = W + Dimensions(J)
End With
Next J
'Ligne suivante
H = H + MaxHeight + 1
W = MargeGauche
End If
Next I
'Impression
PrintMachine.GenePrintOut NombreDeCopies
End Function
Public Function AddElem(ByVal Texte As String, Optional ByVal CenterH As Aligne = Gauche, Optional ByVal CenterV As AligneV = Haut, 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 ForeColor As Long = vbBlack, Optional ByVal BackColor As Long = vbWhite)
CurrentX = CurrentX + 1
If CurrentX > NbrColonnes Then
CurrentX = 1
CurrentY = CurrentY + 1
End If
ReDim Preserve L(NbrColonnes, CurrentY)
L(CurrentX, CurrentY).Contenu = Texte
L(CurrentX, CurrentY).Bold = Bold
L(CurrentX, CurrentY).Italic = Italic
L(CurrentX, CurrentY).UnderLine = UnderLine
L(CurrentX, CurrentY).FontSize = FontSize
L(CurrentX, CurrentY).ForeColor = ForeColor
L(CurrentX, CurrentY).BackColor = BackColor
L(CurrentX, CurrentY).CentreH = CenterH
L(CurrentX, CurrentY).CentreV = CenterV
End Function
Public Function SetNbrColonnes(ByVal Nombre As Integer)
ReDim Dimensions(Nombre)
ReDim Entete(Nombre)
ReDim L(Nombre, 1)
NbrColonnes = Nombre
CurrentX = 0
CurrentY = 1
Dim I As Integer
For I = 1 To Nombre
Me.SetTitre I, ""
Next I
End Function
Public Function SetLargeurColonne(ByVal NumColonne As Byte, ByVal Largeur As Double)
Dimensions(NumColonne) = Largeur
End Function
Private Sub Class_Initialize()
Me.Clear
End Sub
Public Function SetColonne(ByVal NumColonne As Byte, ByVal Titre As String, ByRef PrintMachine As PrnMachine, Optional ByVal CenterH As Aligne = Gauche, Optional ByVal CenterV As AligneV = Haut, Optional ByVal Bold As Boolean = False, Optional ByVal Italic As Boolean = False, Optional ByVal UnderLine As Boolean = False, Optional ByVal FontSize As Integer = 10, Optional ByVal ForeColor As Long = vbBlack, Optional ByVal BackColor As Long = vbWhite, Optional ByVal AutoSize As Boolean = False, Optional ByVal Largeur = 20)
Me.SetTitre NumColonne, Titre, CenterH, CenterV, Bold, Italic, UnderLine, FontSize, ForeColor, BackColor
If AutoSize Then
Me.SetLargeurColonne NumColonne, PrintMachine.GetTextWidth(Titre, Bold, Italic, UnderLine, FontSize) + 2
Else
Me.SetLargeurColonne NumColonne, Largeur
End If
End Function
Public Function SetTitre(ByVal NumColonne As Byte, ByVal Titre As String, Optional ByVal CenterH As Aligne = Gauche, Optional ByVal CenterV As AligneV = Haut, Optional ByVal Bold As Boolean = False, Optional ByVal Italic As Boolean = False, Optional ByVal UnderLine As Boolean = False, Optional ByVal FontSize As Integer = 10, Optional ByVal ForeColor As Long = vbBlack, Optional ByVal BackColor As Long = vbWhite)
Entete(NumColonne).Contenu = Titre
Entete(NumColonne).Bold = Bold
Entete(NumColonne).Italic = Italic
Entete(NumColonne).UnderLine = UnderLine
Entete(NumColonne).FontSize = FontSize
Entete(NumColonne).ForeColor = ForeColor
Entete(NumColonne).BackColor = BackColor
Entete(NumColonne).CentreH = CenterH
Entete(NumColonne).CentreV = CenterV
End Function
Public Function SetTitreListing(ByVal Titre As String, Optional ByVal CenterH As Aligne = Gauche, Optional ByVal Bold As Boolean = False, Optional ByVal Italic As Boolean = False, Optional ByVal UnderLine As Boolean = False, Optional ByVal FontSize As Integer = 10, Optional ByVal ForeColor As Long = vbBlack)
TitrePremierePage.Contenu = Titre
TitrePremierePage.Bold = Bold
TitrePremierePage.Italic = Italic
TitrePremierePage.UnderLine = UnderLine
TitrePremierePage.FontSize = FontSize
TitrePremierePage.ForeColor = ForeColor
TitrePremierePage.CentreH = CenterH
End Function
Public Function Clear()
Me.SetNbrColonnes 0
Me.Orientation = cdlPortrait
CurrentX = 0
CurrentY = 0
End Function
Conclusion :
Cette classe utilise la classe d'impression que j'ai faite : http://www.vbfrance.com/code.aspx?ID=24177
Le principe : on définit les colonnes, le titre du tableau, et on ajoute les éléments, case par cases, de gauche à droite, et de haut en bas. Cette classe gère automatiquement les sauts de page.
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.