problème dans le code impression pdf

netten

XLDnaute Junior
Bonjour le forum,

J'ai aujourd'hui un soucis avec un code qui me permet d'imprimer en pdf.
Alors voilà comment ça marche : J'ai une base de données sur une feuille nommée ("Structure"), dans la colonne AB, je cherche des valeurs sous condition (if cells <0 and bla bla bla) lorsqu'une cellule répond aux condition, je prend certaines valeurs sur la ligne correspondante à la cellule trouvée, puis :

J'exporte ces valeurs dans des labels d'une autre feuille de L1 à L9. Ensuite j'utilise une fonction un peu toute faite pour imprimer cette dernière feuille en pdf. (la mise en page est déjà faite dans la feuille)

Le tout forme une boucle pour tester toutes les cellules de la feuille "Structure" colonne AB. Je dois donc imprimer un certain nombre de pdf.


Mon code fonctionne, à un détail près, les pages imprimée devrait être les unes à la suite des autres. Or, les deux premières impressions sont identiques, ce que je veux dire, c'est qu'au lieu de les imprimer les unes à la suite des autres, ça imprimme deux fois la même, puis saute la prochaine impression, puis réimprime deux fois la même,...


Voici le code, merci beaucoup de votre coup d'oeil :)

Code:
Private Sub CB2_Click()

''''''''''''''''''''''''''''''''''''''''''''définition des variables

Dim lig
Dim MyDate
Dim diff
User = Application.UserName
MyDate = Date
Jour = Mid(MyDate, 1, 2)
mois = Mid(MyDate, 4, 2)
an = Mid(MyDate, 7, 4)

''''''''''''''''''''''''''''''''''''''''''''''bloquer l'accès aux autres boutons

CB2.Enabled = False
CB3.Enabled = False
CB4.Enabled = False
CB11.Enabled = False
CB22.Enabled = False
CB33.Enabled = False
CB44.Enabled = False

'''''''''''''''''''''''''''''''''''''''''''''''effacer toute la table
Dim cell As Range
Set cell = Sheets("15J").Range("A2:A65536")
Range(cell, cell).EntireRow.Delete

        Worksheets("BTEPRE").L1.Caption = ""
        Worksheets("BTEPRE").L2.Caption = ""
        Worksheets("BTEPRE").L2.Caption = ""
        Worksheets("BTEPRE").L3.Caption = ""
        Worksheets("BTEPRE").L4.Caption = ""
        Worksheets("BTEPRE").L5.Caption = ""
        Worksheets("BTEPRE").L6.Caption = ""
        Worksheets("BTEPRE").L7.Caption = ""
        Worksheets("BTEPRE").L8.Caption = ""
        Worksheets("BTEPRE").L9.Caption = ""

''''''''''''''''''''''''''''''''''''''''''''''sélection de la cellule à analyser par sa valeur dans la colone AB
Sheets("Structure").Select
For lig = 4 To 65536

''''''''''''''''''''''''''''''''''''''''''''''remplir le Bon de travail

If Cells(lig, 28).Value > O And Cells(lig, 28).Value < 500 Then

      With Sheets("BTEPRE")

        Worksheets("BTEPRE").L1.Caption = Cells(lig, 28).Value
        Worksheets("BTEPRE").L2.Caption = Cells(lig, 26).Value
        'Worksheets("BTEPRE").L2.Caption = Sheets("Structure").Range("B" & LigSuiv).Value
        'Worksheets("BTEPRE").L3.Caption = Sheets("Structure").Range("F" & LigSuiv).Value
        'Worksheets("BTEPRE").L4.Caption = Sheets("Structure").Range("C" & LigSuiv).Value
        'Worksheets("BTEPRE").L5.Caption = Sheets("Structure").Range("G" & LigSuiv).Value
        'Worksheets("BTEPRE").L6.Caption = Sheets("Structure").Range("B" & J).End(xlUp)
        'Worksheets("BTEPRE").L7.Caption = Sheets("Structure").Range("C" & J).End(xlUp)
        'Worksheets("BTEPRE").L8.Caption = Sheets("Structure").Range("D" & J).End(xlUp)
        'Worksheets("BTEPRE").L9.Caption = Sheets("Structure").Range("A" & LigSuiv).Value
End With

''''''''''''''''''''''''''''''''''''''''''''''imprimer  sous format .pdf

diff = Cells(lig, 29).Value
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
NomExcel = ""
NomPdf = Jour & "." & mois & "." & an & " " & "Maintenance 30 jours" & " " & diff & ".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") = "C:\Documents and Settings\elambert\Bureau\GESTION MAINTENANCE\preventif15J"
.cOption("AutosaveFilename") = NomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Sheets("BTEPRE").Range("A1:C3").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

End If
Next lig

End Sub
 

netten

XLDnaute Junior
Re : problème dans le code impression pdf

bon,...

Je ne sais pas si c'est parce que je ne vous ai pas mis de petit fichier, je ne peux pas, le fichier serait trop grand en taille, c'est un code qui fait travailler beaucoup de données. Un petit coup de pouce s'il vous plait ? En plus c'est pas intéressant comme code ? de pouvoir imprimer une liste de plein de choses en pdf avec une mise en forme par des label sur une autre feuille ?

Juste un petit coup d'oeil, je suis sûr qu'en plus c'est pas grand chose. :)
 

netten

XLDnaute Junior
Re : problème dans le code impression pdf

Bonjour au forum,

Voilà, j'ai fait un petit fichier qui tient tout juste, avec explications. Il faut juste changer le chemin pour l'impression :

C:\Documents and Settings\.............\Bureau


Merci beaucoup ;)

Eric
 

Pièces jointes

  • test.xls
    48.5 KB · Affichages: 47
  • test.xls
    48.5 KB · Affichages: 45
  • test.xls
    48.5 KB · Affichages: 48
Dernière édition:

netten

XLDnaute Junior
Re : problème dans le code impression pdf

ah oui, aussi important : J'ai remarqué que la boucle fonctionne, car vous remarquerez que j'ai mis le nom d'une cellule dans l'enregistrement du ficher, pour tester ma boucle, voir si ce n'était pas elle qui déconnait. Et bien non, car chaque impresion est enregistré avec le la bonne valeur de cellule (indique la bonne ligne).

Donc je pense que le problème vient de l'expression utilisée pour remplir mon label, parce que l'impression fait deux fois la même ligne alors que le nom du ficher indique bien qu'on est passé à l'analyse de la cellule suivante.

Mon label se rempli n'importe comment, mais mon écritude me semble pas trop mauvaise, alors ...
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
314 645
Messages
2 111 536
Membres
111 182
dernier inscrit
savio