Imprimer ListBox d'un multipage

Version imprimable

29/06/2021, 13h31
Vba14

Imprimer ListBox d'un multipage

Bonjour à tous,

Je suis à la recherche d'une procédure pour imprimer les données d'une ListBox. En fait imprimer le résultat obtenu.
Dans un formulaire multipages avec 6 pages, (UfCherche/MultiPage1). Dans la page VILLE (Index 1), j'ai une ListBox (LstVille) qui est alimentée à partir d'une donnée choisie dans un ComboBox (CmbVille).
Une fois que les données sont dans la List, je souhaite les imprimer en cliquant sur un bouton (BtImp1).
Merci par avance pour votre aide
Meilleures salutations

Bon j'ai avancé un peu :

J'ai mis en place ce code qui m'imprime bien les données de la ListBox mais pas comme je le souhaite.
En effet, le résultat est imprimé en portrait et sur 3 feuilles.
Je souhaite donc que l'impression se fasse au format "Paysage" et ajusté à une seule feuille.
Pouvez-vous m'aider s'il vous plait ?
Merci par avance

Voici mon début de code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Private Sub BtImp1_Click() Dim Tableau() As Variant Dim I As Integer Dim J As Byte Application.ScreenUpdating = False Workbooks.Add 'Création d'un nouveau classeur temporaire Tableau() = LstVille.List J = LstVille.ColumnCount I = LstVille.ListCount Range("A1:" & Cells(I, J).Address) = Tableau() 'Option pour adapter la largeur des colonnes à la taille des données ActiveSheet.Range("A1:" & Cells(I, J).Address).EntireColumn.AutoFit ActiveWorkbook.PrintOut 'Impression Application.DisplayAlerts = False 'Pas d'alerte de sauvegarde ActiveWorkbook.Close False 'Suppression du classeur temporaire Application.ScreenUpdating = True End Sub

J'ai trouvé pour ajuster l'impression à la feuille. Mais là où je sèche c'est pour mettre des en-têtes aux colonnes.

La première colonne : Sites
La 2ème : Désignation
La 3ème : N° Boîte
La 4ème : N° Ligne

Voici le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
Private Sub BtImp1_Click()
Dim Tableau() As Variant
Dim I As Integer
Dim J As Byte
 
Application.ScreenUpdating = False
Workbooks.Add 'Création d'un nouveau classeur temporaire
 
Tableau() = LstVille.List
J = LstVille.ColumnCount
I = LstVille.ListCount
Range("A1:" & Cells(I, J).Address) = Tableau()
 
'Option pour adapter la largeur des colonnes à la taille des données
ActiveSheet.Range("A1:" & Cells(I, J).Address).EntireColumn.AutoFit
 
With ActiveSheet.PageSetup
    .Orientation = xlLandscape
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With
 
ActiveWorkbook.PrintOut 'Impression
Application.DisplayAlerts = False 'Pas d'alerte de sauvegarde
ActiveWorkbook.Close False 'Suppression du classeur temporaire
 
Application.ScreenUpdating = True
End Sub

J'ai trouvé.
Voici le code final. Si vous pensez qu'il peut être amélioré, n'hésitez pas.
Merci par avance
Meilleures salutations

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Private Sub BtImp1_Click()
Dim Tableau() As Variant
Dim I As Integer
Dim J As Byte
 
Application.ScreenUpdating = False
Workbooks.Add 'Création d'un nouveau classeur temporaire
 
Tableau() = LstVille.List
J = LstVille.ColumnCount
I = LstVille.ListCount
Range("A2:" & Cells(I, J).Address) = Tableau()
Range("A1").Value = "Site"
Range("B1").Value = "Désignation"
Range("C1").Value = "N° Boîte"
Range("D1").Value = "N° Ligne"
 
'Option pour adapter la largeur des colonnes à la taille des données
ActiveSheet.Range("A2:" & Cells(I, J).Address).EntireColumn.AutoFit
 
With ActiveSheet.PageSetup
    .Orientation = xlLandscape
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With
 
ActiveWorkbook.PrintOut 'Impression
Application.DisplayAlerts = False 'Pas d'alerte de sauvegarde
ActiveWorkbook.Close False 'Suppression du classeur temporaire
 
Application.ScreenUpdating = True
End Sub