IMPRESSION DU CONTENU D'UN LISTVIEW
Mode opératoire :
1/ Créer un nouveau projet VB6 avec un feuille (Form1)
2/ Sur la feuille, créer un listview (nom = ListView1)
3/ Sur la feuille, créer un bouton de commande (nom = Command1)
4/ Copier le code source suivant dans la zone de code de la feuille
5/ Exécuter puis cliquer sur le bouton Command1
Remarques :
- Ne nécessite pas de controle ActiveX ou API spécifique
- Utilisation du ratio des tailles des colonnes du listview
Source / Exemple :
Option Explicit
Private Sub Command1_Click()
' Appel de la fonction d'impression
Call ImprimerListView(Me.ListView1, "Ceci est le titre", "Ceci est le sous-titre")
End Sub
Private Sub Form_Load()
Dim i As Long
' Sélection du mode détaillé
Me.ListView1.View = lvwReport
' Création des colonnes
Me.ListView1.ColumnHeaders.Add 1, , "Colonne 1"
Me.ListView1.ColumnHeaders.Add 2, , "Colonne 2"
Me.ListView1.ColumnHeaders.Add 3, , "Colonne 3"
' Remplissage du listview
For i = 1 To 20
Me.ListView1.ListItems.Add i, , "Valeur " & CStr(i) & ",1"
Me.ListView1.ListItems(i).SubItems(1) = "Valeur " & CStr(i) & ",2"
Me.ListView1.ListItems(i).SubItems(2) = "Valeur " & CStr(i) & ",3"
Next i
End Sub
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 = 35
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 As Long
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) & "/" & CStr(lNbPages)
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
For Each liItem In lvwSource.ListItems
lCurYtmp = p.CurrentY
For idxCol = 1 To lvwSource.ColumnHeaders.Count
If lvwSource.ColumnHeaders(idxCol).Width > 0 Then
' Détermine le nombre de caractères affichables
p.FontBold = False
lNbCarAff = Int(((lvwSource.ColumnHeaders(idxCol).Width * 100) / lLargTot) / p.TextWidth("A"))
If idxCol = 1 Then
lCurXtmp = 0
p.CurrentX = lCurXtmp
p.CurrentY = lCurYtmp
p.FontBold = False: p.Print Left(liItem.Text, lNbCarAff)
Else
lCurXtmp = lCurXtmp + (lvwSource.ColumnHeaders(idxCol - 1).Width * 100) / lLargTot
p.CurrentX = lCurXtmp
p.CurrentY = lCurYtmp
p.FontBold = False: p.Print Left(liItem.SubItems(idxCol - 1), lNbCarAff)
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
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) & "/" & CStr(lNbPages)
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
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.