Classe d'impression de tableaux

Soyez le premier à donner votre avis sur cette source.

Snippet vu 8 851 fois - Téléchargée 34 fois

Contenu du snippet

C'est une classe qui permet d'imprimer un tableau facilement.

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.

A voir également

Ajouter un commentaire

Commentaires

Messages postés
1
Date d'inscription
vendredi 4 février 2005
Statut
Membre
Dernière intervention
7 février 2005

Moi je suis vraiment débutante et j'avoue que je nage un peu :je suis étudiante et je suis en plein projet de dévellopement utilisant du visual basic et j'aurais effectivement besoin d'imprimer des tableaux de données ...

Le problème visiblement avec visual basic , c'est que pour imprimer il faut faire du "paramètrage ligne par ligne" , c'est super long , c'est pour ça qu'il me parraissait intéressant de passer par une feuille excel, d'où mon intérêt pour ton code ...
Mais comme je l'ai déjà dit , je suis vraiment une débutante et vu la longueur du code, je suis bien larguée ..

t'aurais pas une application (une feuille ou "form" .frm) qui illustrerai ce code pour m'aider à visualiser un peu mieux ce que ça veut dire!!!

merci

becasscol
Messages postés
373
Date d'inscription
samedi 1 juin 2002
Statut
Membre
Dernière intervention
17 juin 2013

Tout bonnement génial !
10/10

JLN

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.