Exporter pages 1 2 et 4 au format pdf

Version imprimable

Bonsoir, j'aimerais exporter au format pdf les pages 1 2 et 4 de ma feuille "RAPPORT"
Petit soucis : je n'arrive pas a sélectionner les pages 1 2 et 4 , j'utilise donc PageBreack pour délimiter mes pages
Petit soucis : j'arrive a sélectionner les plages 1 et 2 des pages 1 et 2 , mais quand il s'agit de sélectionner les plages 1 2 et 3 pour les trois pages , excel m'indique que
la ligne " Range(Plage1, Plage2, Plage3).Select " a un nombre d'argument incorrect ou affectation de propriété incorrecte. Je ne trouve pas mon erreur.
Merci de votre aide
Cordialement

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub RAPPORT_Bouton6_Cliquer()
       Dim LeParcours As String, LeRep As String
 
    LeParcours = Range("H10").Value
    Dat = Right(Range("G10").Value, 2)
    Dat1 = "HYD20" & Dat
 
 
        Dim LI
        Dim Plage1
        Dim Plage2
        Dim Plage3
 
 
    LI = ThisWorkbook.Worksheets("RAPPORT").HPageBreaks(1).Location.Row - 1
    Plage1 = "A1:H" & LI
    LI2 = LI * 2
    Plage2 = "A" & LI + 1 & ":H" & LI2 + 1
    Plage3 = "I" & LI + 1 & ":Q" & LI2 + 1
    Range(Plage1).Select
 
    Dim Ma_Forme As Shape
 Dim i
 Dim P
 For i = 1 To 2
For Each Ma_Forme1 In Sheets("RAPPORT").Shapes
    If Ma_Forme1.Name = "Image" & i Then
 
Range(Plage1, Plage2).Select
        Exit For
    End If
    Next Ma_Forme1
     Next i
 
      Dim o
 For o = 3 To 4
For Each Ma_Forme In Sheets("RAPPORT").Shapes
    If Ma_Forme.Name = "Image" & o Then
 
   Range(Plage1, Plage2, Plage3).Select
 
 
        Exit For
    End If
    Next Ma_Forme
     Next o
 
 
 
 
        Dim FSO As Object, sNomDossier As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sNomDossier = "HYD" & LeParcours
     Chemin = Sheets("Données").Range("A30").Value
    sChemin = Chemin & "\" & Dat1 & "\" & sNomDossier & "/"
 
        If Not FSO.FolderExists(sChemin) Then FSO.CreateFolder (sChemin)
     Set FSO = Nothing
LeRep = Chemin & "\" & Dat1 & "\" & sNomDossier & "/" ' à adapter
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       LeRep & "HYD" & LeParcours & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, _
         OpenAfterPublish:=True
 Sheets("RAPPORT").Range("A1").Select
    End Sub

12/07/2017, 00h44
kiki29

Salut, enregistre l'ensemble de la feuille de la page 1 à 4 puis supprime la page 3.
voir ici PDFCreator Suppression de la page X d'un fichier PDF. Il s'agit de PDFCreator 1.7.3

Re, à adapter ici via PDFCreator 1.7.3

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
Option Explicit
 
Sub Tst()
Dim sInPDF As String
Dim sOutPDF As String
Dim Pdf As Object
 
    Set Pdf = CreateObject("pdfforge.pdf.pdf")
 
    sInPDF = ThisWorkbook.Path & "\" & "Tableau.pdf"
    sOutPDF = ThisWorkbook.Path & "\" & "Final.pdf"
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=sInPDF, _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
 
    Pdf.RemovePageFromPDFFile sInPDF, sOutPDF, 3
    Set Pdf = Nothing
 
    Kill sInPDF
End Sub

12/07/2017, 01h12
Patouillou

Re, il m'indique qu'un composant axcitveX ne peut pas créer d'objets ...
12/07/2017, 01h18
kiki29

Re, Il faut installer PDFCreator 1.7.3
12/07/2017, 01h20
Patouillou

Mon soucis est que je ne suis pas le seul utilisateur de cette base excel, elle est utiliser sur plusieurs machines donc c'est compliquer de procéder ainsi..
12/07/2017, 01h25
kiki29

Et bien comme je dis toujours : pas de bras ..... pas de chocolat.
12/07/2017, 01h28
Patouillou

Il doit bien y avoir un moyen .. Je ne comprend pas pourquoi la methode "Range(Plage1, Plage2, Plage3).Select" ne fonctionne pas ...

Re, plus simple, à adapter à ton contexte

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Tst_02()
Dim sOutPDF As String
Dim Rg As Range
 
    sOutPDF = ThisWorkbook.Path & "\" & "Test.pdf"
 
    Set Rg = Application.Union(Feuil1.Range("Plage_A"), Feuil1.Range("Plage_B"), Feuil1.Range("Plage_D"))
 
    Rg.ExportAsFixedFormat Type:=xlTypePDF, _
                           Filename:=sOutPDF, _
                           Quality:=xlQualityStandard, _
                           IncludeDocProperties:=True, _
                           IgnorePrintAreas:=False, _
                           OpenAfterPublish:=False
    Set Rg = Nothing
End Sub

Cela fonctionne avec la plage 1 lorsque qu'il n'y a aucunes photos
Mais dès que j'ajoute une photo, erreur sur la ligne "Set Rg = Application.Union(Plage1, Plage2)" objet requis..

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub RAPPORT_Bouton6_Cliquer()
       Dim LeParcours As String, LeRep As String
 
    LeParcours = Range("H10").Value
    Dat = Right(Range("G10").Value, 2)
    Dat1 = "HYD20" & Dat
 
 
        Dim LI
        Dim Plage1
        Dim Plage2
        Dim Plage3
 
 
    LI = ThisWorkbook.Worksheets("RAPPORT").HPageBreaks(1).Location.Row - 1
    Plage1 = "A1:H" & LI
    LI2 = LI * 2
    Plage2 = "A" & LI + 1 & ":H" & LI2 + 1
    Plage3 = "I" & LI + 1 & ":Q" & LI2 + 1
    Range(Plage1).Select
    Dim Ma_Forme As Shape
 Dim i
 Dim P
 For i = 1 To 2
For Each Ma_Forme1 In Sheets("RAPPORT").Shapes
    If Ma_Forme1.Name = "Image" & i Then
  Set Rg = Application.Union(Plage1, Plage2)
    Range(Rg).Select
        Exit For
    End If
    Next Ma_Forme1
     Next i
 
      Dim o
 For o = 3 To 4
For Each Ma_Forme In Sheets("RAPPORT").Shapes
    If Ma_Forme.Name = "Image" & o Then
 
 
 
 Set Rg = Application.Union(Plage1, Plage2, Plage3)
    Range(Rg).Select
 
 
        Exit For
    End If
    Next Ma_Forme
     Next o
 
 
        Dim FSO As Object, sNomDossier As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sNomDossier = "HYD" & LeParcours
     Chemin = Sheets("Données").Range("A30").Value
    sChemin = Chemin & "\" & Dat1 & "\" & sNomDossier & "/"
 
        If Not FSO.FolderExists(sChemin) Then FSO.CreateFolder (sChemin)
     Set FSO = Nothing
LeRep = Chemin & "\" & Dat1 & "\" & sNomDossier & "/" ' à adapter
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       LeRep & "HYD" & LeParcours & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, _
         OpenAfterPublish:=True
 Sheets("RAPPORT").Range("A1").Select
    End Sub

12/07/2017, 02h01
kiki29

Ici tout fonctionne avec ou sans photos.
12/07/2017, 02h05
Patouillou

Ici ??
13/07/2017, 00h15
Patouillou

Up