selectionner les onglets à afficher depuis une liste box pour les combiner en un pdf

domi152

XLDnaute Nouveau
Voila mon soucis je creer un us form avec une list box contenant la liste de mais différentes feuilles ( 12 max )
Cela est ok.

Ensuite je dois pouvoir selectioner 1 ou deux ou trois etc feuilles et generer un seul dpf avec uniquement les feuilles selectionner .

Deplus il serait super de pouvoir n'imprimer que les lignes qui contiennent quelques chose.

La selection plusd ou moins ok par contre pdfcreator generer bien les differentes feuilles selectioneées mais lors du combineall je n'obtient que la derniere feuille.

Merci d'avance

Je joint mon code.
Private Sub CommandButton1_Click()
Dim i As Integer
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
NomExcel = ThisWorkbook.Name
NomPdf = Left(NomExcel, Len(NomExcel) - 4) & ".pdf"
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = ThisWorkbook.Path
.cOption("AutosaveFilename") = NomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
End With
With PdfJob
For i = 0 To IMPRIMER.ListBox1.ListCount - 1
If IMPRIMER.ListBox1.Selected(i) = True Then Sheets(i + 1).PrintOut copies:=1, ActivePrinter:="PDFCreator"
Next
End With
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
MsgBox "fichier prepare"
With PdfJob
.cCombineAll
.cPrinterStop = False
End With
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
IMPRIMER.Hide
MsgBox "fichier reuni"
With PdfJob
.cDefaultprinter = DefaultPrinter
.cClearCache
.cClose
End With
Set PdfJob = Nothing
End Sub

Private Sub UserForm_Initialize()

ListBox1.Clear

nb_onglets = Worksheets.Count
For i = 1 To nb_onglets

If Worksheets(i).Name <> "LISTE" Then
If Worksheets(i).Name <> "LISTE" Then
ListBox1.AddItem (Worksheets(i).Name)
Else: ListBox1.AddItem (Worksheets(i + 1).Name)
i = i + 1
End If
End If

Next i

End Sub
 
Dernière édition:

domi152

XLDnaute Nouveau
Re : selectionner les onglets à afficher depuis une liste box pour les combiner en un

ci-joint un exemple du classeur


Voila mon soucis je creer un us form avec une list box contenant la liste de mais différentes feuilles ( 12 max )
Cela est ok.

Ensuite je dois pouvoir selectioner 1 ou deux ou trois etc feuilles et generer un seul dpf avec uniquement les feuilles selectionner .

Deplus il serait super de pouvoir n'imprimer que les lignes qui contiennent quelques chose.

La selection plusd ou moins ok par contre pdfcreator generer bien les differentes feuilles selectioneées mais lors du combineall je n'obtient que la derniere feuille.

Merci d'avance

Je joint mon code.
Private Sub CommandButton1_Click()
Dim i As Integer
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
NomExcel = ThisWorkbook.Name
NomPdf = Left(NomExcel, Len(NomExcel) - 4) & ".pdf"
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = ThisWorkbook.Path
.cOption("AutosaveFilename") = NomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
End With
With PdfJob
For i = 0 To IMPRIMER.ListBox1.ListCount - 1
If IMPRIMER.ListBox1.Selected(i) = True Then Sheets(i + 1).PrintOut copies:=1, ActivePrinter:="PDFCreator"
Next
End With
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
MsgBox "fichier prepare"
With PdfJob
.cCombineAll
.cPrinterStop = False
End With
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
IMPRIMER.Hide
MsgBox "fichier reuni"
With PdfJob
.cDefaultprinter = DefaultPrinter
.cClearCache
.cClose
End With
Set PdfJob = Nothing
End Sub

Private Sub UserForm_Initialize()

ListBox1.Clear

nb_onglets = Worksheets.Count
For i = 1 To nb_onglets

If Worksheets(i).Name <> "LISTE" Then
If Worksheets(i).Name <> "LISTE" Then
ListBox1.AddItem (Worksheets(i).Name)
Else: ListBox1.AddItem (Worksheets(i + 1).Name)
i = i + 1
End If
End If

Next i

End Sub
 

Pièces jointes

  • OJTYPE.xls
    184.5 KB · Affichages: 37

Discussions similaires

Statistiques des forums

Discussions
312 238
Messages
2 086 492
Membres
103 234
dernier inscrit
matteo75654548