Modifier à nouveau un code de convertion en PDF... [Résolu]

Signaler
Messages postés
166
Date d'inscription
dimanche 22 janvier 2012
Statut
Membre
Dernière intervention
30 juillet 2015
-
Messages postés
166
Date d'inscription
dimanche 22 janvier 2012
Statut
Membre
Dernière intervention
30 juillet 2015
-
Bonjour le forum....

Donc voilà, j'ai, une macro que j'aimerais modifier... mais je ne sais pas où... je vous explique...


Quand je créé des rapports, j'ai une macro qui me permet de convertir les feuilles sélectionnées... elle fonctionne à merveille... seulement quand j'ai 3 ou 4 rapports à modifier...ça va on valide la conversion 3 ou 4 fois (sur le message "le pointage xxx se trouve a cet emplacement xxx") mais quand il y en a 20 ça commence à être pennible... Hors, ce que je voudrais, c'est que quand je lance la convertion, il m'annonce la fin quand il à tout convertit, du genre "Les rapports de : (affiche le nom des personnes) se trouve a cet emplacemement : xxxxxx .

Voici le code en question :


Sub ToPdf()
Dim pdfjob As Object
Dim DefaultPrinter
chemsave = ThisWorkbook.Sheets("MATRICE").Range("A111").Value 'tu peux changer la feuille et la cellule
'If chemsave = "" Then Exit Sub
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("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = chemsave 'chemin destination
.cOption("AutosaveFilename") = feuil & ".pdf" 'nom de la feuille
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=32766, Copies:=1, ActivePrinter:="PDFCreator" 'on imprime la feuille active
'ThisWorkbook.PrintOut Copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultprinter = DefaultPrinter
.cClearCache
.cClose
End With
Set pdfjob = Nothing
'Dim Ret As Variant
'Ret = ShellExecute(hwnd, "open", chemsave & To_PDF.ComboBox1.Value & ".pdf", "", vbNullString, 1) 'ouverture du pdf
MsgBox "Votre PDF se trouve à cet emplacement: " & chemsave, vbInformation, "Convertir en PDF"
End Sub



Je vous remercie à tous pour votre aide... passez une bonne journée...

Christian


--

5 réponses

Messages postés
32054
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
11 avril 2021
345
Bonjour,

macro que j'aimerais modifier... mais je ne sais pas où.

...
le message "le pointage xxx se trouve a cet emplacement xxx"

Il est facile de voir où se trouve ce message... non ??
MsgBox "Votre PDF se trouve à cet emplacement: " & chemsave, vbInformation, "Convertir en PDF"


1 - Supprimer ( ou mettre en commentaire) cette ligne de code
2 - Changer la sub en FUNCTION
3 - Mettre en sortie de cette fonction la variable chemsave
4 - Dans ta boucle qui fait appel à ton code de conversion ( code que tu ne nous a pas montré ) tu récupères la valeur issue de ta fonction et tu t'en sert pour générer ton message de fin.

Messages postés
166
Date d'inscription
dimanche 22 janvier 2012
Statut
Membre
Dernière intervention
30 juillet 2015
2
Bonjour Jordane45,

Comment vas-tu ?

Donc effectivement, si je ne met pas tous les morceaux....

Donc voici la boucle qui fait appel à la procédure de conversion :

Private Sub Cmd_PDF_Click()
Dim i As Byte
'boucle sur les éléments de la ListBox
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
feuil = ListBox1.List(i) 'nom de la feuille
Sheets(feuil).Select
ToPdf
End If
Next i
End Sub


Je ne reposte pas le "ToPdf"

Merci pour ton aide... (j'ai pas tout compris pour la fonction ?)

Passes une bonne après midi :)

Christian

--
Messages postés
32054
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
11 avril 2021
345
Hello,
Ca va bien merci.

Voila..ça devrait te donner quelque chose de ce genre :
( A adapter à tes besoins bien entendu)


Changement de SUB en FUNCTION

Function ToPdf(nomFeuille as string)
Dim pdfjob As Object
Dim DefaultPrinter

 Sheets(nomFeuille).Select


chemsave = ThisWorkbook.Sheets("MATRICE").Range("A111").Value 'tu peux changer la feuille et la cellule
'If chemsave = "" Then Exit Sub
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("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = chemsave 'chemin destination
.cOption("AutosaveFilename") = feuil & ".pdf" 'nom de la feuille
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=32766, Copies:=1, ActivePrinter:="PDFCreator" 'on imprime la feuille active
'ThisWorkbook.PrintOut Copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultprinter = DefaultPrinter
.cClearCache
.cClose
End With
Set pdfjob = Nothing
 'Dim Ret As Variant
 'ouverture du pdf
'Ret = ShellExecute(hwnd, "open", chemsave & To_PDF.ComboBox1.Value & ".pdf", "", vbNullString, 1)
ToPdf = "Votre PDF se trouve à cet emplacement: " & chemsave
End Function




Private Sub Cmd_PDF_Click()
    Dim i As Byte
    Dim msg as string
    Dim feuil  as string
    'boucle sur les éléments de la ListBox
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
          feuil = ListBox1.List(i) 'nom de la feuille
          'appel de la fonction
          msg = msg & vbLf &  ToPdf(feuil )
    End If
    Next 
'Affichage du résultat
afficheMessage = msgbox (msg, vbInformation, "Convertir en PDF")
End Sub



Avant de poser une question, merci de lire la charte du site.
Cordialement, Jordane
Messages postés
166
Date d'inscription
dimanche 22 janvier 2012
Statut
Membre
Dernière intervention
30 juillet 2015
2
Merci Jordane45,

Je test ça dès ce soir, car je suis au taf... puis vu que je viens de me faire allumer... on va éviter d'envenimer la chose...


Mais merci, c'est sympas :)

Bonne après midi

christian

--
Messages postés
166
Date d'inscription
dimanche 22 janvier 2012
Statut
Membre
Dernière intervention
30 juillet 2015
2
Bonjour Jordane45,

Donc j'ai enfin reussi à tester le code, donc quelque bug rencontré ( de ma faute ! ) ;)

Mais ce n'est pas exactement ce que je souhaitais du à ma mauvaise explication... du moins en partie).

Lorsque je converti les rapports, il me met bien le message final... par-contre j'ai eu une mauvaise idee de vouloir un seul et meme fichier, car du coup mon fichier PDF n'a plus de nom... mais juste une extension ".pdf" Avec un seul rapport alors que j'en converti plusieurs...
Donc changement de programme... je garde mes rapport séparés, avec un seul message quand il a fini... du style "Vos rapports ont bien été converti et se trouve a cet emplacement"...etc...

Donc là je dois juste commenter la ligne msgBox du module ToPdf() et la remettre en Sub ?

Et du coups je vais mettre une progressBar pour que le redacteur puisse voir l'avancement de la conversion car 2 rapports + le message--- ok mais 20 rapports + le message... ça commence à être long.. lol.. alors si une barre progresse... c'est mieux.. me reste à aller chercher comment que ça se passe....

A moins que d'autre solution existe... en ce cas je suis preneur...

Bonne journée à toi

Christian










--