Impression d'un listview (suite du code de vbfab du 3/10/2002)

0/5 (3 avis)

Snippet vu 6 015 fois - Téléchargée 29 fois

Commenter

Contenu du snippet

Le code source de base est l'oeuvre de vbfab (source du 3/10/2002), je n'ai fait que rajouter la possibilite d'imprimer une cellule de ListView en entier (et non les lNbCarAff premiers).

La fonction est a placer dans un module global, puis elle est appelee par:
ImprimerListView(Votre_list_view, "Titre", "Sous-Titre")

Source / Exemple : 


Public Sub ImprimerListView(lvwSource As ListView, sTitre As String, sSousTitre As String, Optional ByVal sNomPolice As String = "Arial", Optional ByVal iTaillePolice As Integer = 10)
    On Error GoTo Err_Main
    Const lNB_MAX_ELEM_PAGE As Long = 22
    Dim p As Printer
    Dim lComptElem As Long
    Dim liItem As ListItem
    Dim idxCol As Integer
    Dim lLargTot As Long
    Dim lCurXtmp As Long, lCurYtmp As Long
    Dim lNumPageCour As Long, lNbPages As Long
    Dim sApplication As String, sDate As String
    Dim lNbCarAff, lNbCarCur, lYMax, lY, lElem, lElemMax, lNbCarCut As Long
    Dim sText As String
    
    
    sTitre = UCase(Trim(sTitre))
    sApplication = App.Title & " v" & CStr(App.Major) & "." & CStr(App.Minor) & "." & CStr(App.Revision)
    sDate = Format(Now, "dd/mm/yyyy")
    '   Calcul de la largeur totale des colonnes du listview
    lLargTot = 0
    For idxCol = 1 To lvwSource.ColumnHeaders.Count
        lLargTot = lLargTot + lvwSource.ColumnHeaders(idxCol).Width
    Next
    '   Détermination du nombre de pages, initialisation du numéro de la première page
    lNbPages = Int(lvwSource.ListItems.Count / lNB_MAX_ELEM_PAGE) + 1
    lNumPageCour = 1
        
    '   Instancie l'imprimante cible (imprimante par défaut)
    Set p = Printer

    '   Initialisation de la page
    p.Orientation = vbPRORLandscape
    p.Font = sNomPolice: p.FontSize = iTaillePolice
    p.ScaleHeight = 100: p.ScaleWidth = 100
            
    '   Positionne le titre et le sous-titre de la page
    p.FontBold = True: p.CurrentX = 50 - (p.TextWidth(sTitre) / 2): p.CurrentY = 3: p.Print sTitre
    p.FontBold = False: p.CurrentX = 90: p.CurrentY = 3: p.Print "Page " & CStr(lNumPageCour)
    p.FontBold = False: p.CurrentX = 50 - (p.TextWidth(sSousTitre)) / 2: p.CurrentY = 5: p.Print sSousTitre
    
    '   Positionne les en-têtes de colonnes
    p.CurrentX = 0
    For idxCol = 1 To lvwSource.ColumnHeaders.Count
        lCurXtmp = p.CurrentX
        p.CurrentY = 10
        If lvwSource.ColumnHeaders(idxCol).Width > 0 Then
            p.FontBold = True: p.Print lvwSource.ColumnHeaders(idxCol).Text
        End If
        p.CurrentX = lCurXtmp + (lvwSource.ColumnHeaders(idxCol).Width * 100) / lLargTot
    Next
    p.Line (0, 13)-(100, 13)
    
    '   Ajout des éléments
    p.CurrentY = 14
    lComptElem = 0
    lYMax = 0
    lY = 0
    For Each liItem In lvwSource.ListItems
        lCurYtmp = p.CurrentY + lYMax
        lYMax = 0
        lY = 0
        lElem = 0
        lElemMax = 0
        For idxCol = 1 To lvwSource.ColumnHeaders.Count
            lY = 0
            If lvwSource.ColumnHeaders(idxCol).Width > 0 Then
                '   Détermine le nombre de caractères affichables
                p.FontBold = False
                lElem = 0
                lNbCarAff = Int(((lvwSource.ColumnHeaders(idxCol).Width * 100) / lLargTot) / p.TextWidth("A"))
                
                If idxCol = 1 Then
                    lCurXtmp = 0
                    p.CurrentX = lCurXtmp
                    p.CurrentY = lCurYtmp
                    sText = liItem.Text
                Else
                    lCurXtmp = lCurXtmp + (lvwSource.ColumnHeaders(idxCol - 1).Width * 100) / lLargTot
                    p.CurrentX = lCurXtmp
                    p.CurrentY = lCurYtmp
                    sText = liItem.SubItems(idxCol - 1)
                End If
                lNbCarCut = lNbCarAff
                If Len(sText) > lNbCarAff Then
                    lNbCarCut = InStrRev(Left(sText, lNbCarAff), " ")
                    If lNbCarCut = 0 Then
                        lNbCarCut = lNbCarAff
                    End If
                End If
                
                p.FontBold = False: p.Print Left(sText, lNbCarCut)
                If Len(sText) > lNbCarCut Then
                        lNbCarCur = lNbCarCut
                        While lNbCarCur < Len(sText)
                            If idxCol < lvwSource.ColumnHeaders.Count Then
                                lY = lY + 1.5
                                p.CurrentY = lCurYtmp + lY
                            End If
                            lElem = lElem + 1
                            p.CurrentX = lCurXtmp
                            If Len(Mid(sText, lNbCarCur)) > lNbCarAff Then
                                lNbCarCut = InStrRev(Mid(sText, lNbCarCur + 1, lNbCarAff), " ")
                                If lNbCarCut = 0 Then
                                    lNbCarCut = lNbCarAff
                                End If
                            End If
                            p.FontBold = False: p.Print Mid(sText, lNbCarCur + 1, lNbCarCut)
                            lNbCarCur = lNbCarCur + lNbCarCut
                        Wend
                End If
                If lYMax < lY Then
                    lYMax = lY
                End If
                If lElemMax < lElem Then
                    lElemMax = lElem
                End If
            Else
                lCurXtmp = lCurXtmp + (lvwSource.ColumnHeaders(idxCol - 1).Width * 100) / lLargTot
            End If
        Next
        
        '   Incrémente le nombre d'éléments imprimés
        lComptElem = lComptElem + 1 + lElemMax
                
        If lComptElem = lNB_MAX_ELEM_PAGE Then
            lComptElem = 0  '   Réinitialise le nomde d'élément ecrits
            p.Line (0, 90)-(100, 90)    '   Trace la ligne de fin de liste
            p.CurrentX = 5: p.CurrentY = 93: p.FontBold = True: p.Print sApplication
            p.CurrentX = 85: p.CurrentY = 93: p.FontBold = False: p.Print sDate
            p.NewPage    '   Change de page
            lNumPageCour = lNumPageCour + 1
            '   Positionne le titre et le sous-titre de la page
            p.FontBold = True: p.CurrentX = 50 - (p.TextWidth(sTitre) / 2): p.CurrentY = 3: p.Print sTitre
            p.FontBold = False: p.CurrentX = 90: p.CurrentY = 3: p.Print "Page " & CStr(lNumPageCour)
            p.FontBold = False: p.CurrentX = 50 - (p.TextWidth(sSousTitre)) / 2: p.CurrentY = 5: p.Print sSousTitre
            '   Positionne les en-têtes de colonnes
            p.CurrentX = 0
            For idxCol = 1 To lvwSource.ColumnHeaders.Count
                lCurXtmp = p.CurrentX
                p.CurrentY = 10
                If lvwSource.ColumnHeaders(idxCol).Width > 0 Then
                    p.FontBold = True
                    p.Print lvwSource.ColumnHeaders(idxCol).Text
                    p.FontBold = False
                End If
                p.CurrentX = lCurXtmp + (lvwSource.ColumnHeaders(idxCol).Width * 100) / lLargTot
            Next
            p.Line (0, 13)-(100, 13)
            p.CurrentY = 14
        End If
    Next liItem
    
    '   Ajoute le pied de page de la dernière page
    p.Line (0, 90)-(100, 90)    '   Trace la ligne de fin de liste
    p.CurrentX = 5: p.CurrentY = 93: p.FontBold = True: p.Print sApplication
    p.CurrentX = 85: p.CurrentY = 93: p.FontBold = False: p.Print sDate
    
    p.EndDoc    '   Lance l'impression du document créé
    
Fin:
    On Error Resume Next
    Set p = Nothing
    Exit Sub
    
Err_Main:
    If Not (p Is Nothing) Then p.KillDoc     'Annule l'impressino du document
    MsgBox Err.Description, vbCritical, App.Title
    Resume Fin

End Sub

A voir également

Ajouter un commentaire Commentaires
cs_tolt Messages postés 270 Date d'inscription mardi 17 décembre 2002 Statut Membre Dernière intervention 4 avril 2019
14 août 2008 à 15:56
Bonjour,

J'ai récupéré votre source qui imprime le contenu d'un ListView sur un format A4 uniquement.Avez une solution pour imprimer le contenu d'un ListView mais en format continu "Zone Vert" 11 pouces sur 38 pouces.

Merci d'avance et félicitation de votre code bien pratique.
Guga59 Messages postés 6 Date d'inscription lundi 7 mars 2005 Statut Membre Dernière intervention 29 avril 2005
29 mars 2005 à 14:02
slt moi je code en ce moment Sous VBA avec Excel. J'ai testé ton code mais cela ne marche pas.

Il ne trouve pas la variable Printer...
Comment faire dans ce cas??
merci

Guga
cs_EBArtSoft Messages postés 4525 Date d'inscription dimanche 29 septembre 2002 Statut Modérateur Dernière intervention 22 avril 2019 9
7 oct. 2003 à 15:32
Ce qui serait encore mieu ce serait de choisir le
listview/treeview avec la sourie (setcapture)
qu'il soit dans notre app ou non a partir d'un
handle de fenetre (hWnd) puis de l'imprimer !

@+
S'inscrire maintenant

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.