XL 2013 Impression PDF par vba

nicroq

XLDnaute Occasionnel
Bonjour a tous et merci pour votre aide.

Apres de longues recherhches je n'arrive pas a resoudre mon probleme... Je souhaiterai par VBA imprimer en PDF des ranges des différentes worksheet sur un seul et meme PDF.
AUtrement dit par exemple sur la feuille1 j'ai la range A1:C28 , sur la feuille2 la range C58:E99 et sur la feuille 3 la range C20:D58...

VOici le code qui fonctionne pour l'impression de plusieurs sheet et non range;..
Sub Enregistrer_1_seul_PDF()
Dim sh As Worksheet, i&, Chemin$
Dim oSh As Object, pfile As Object
Dim pIni As Variant
Application.ScreenUpdating = 0
'For i = 2 To Sheets.Count
With Worksheets("Graphes").PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = True
End With

With Worksheets("Analyses").PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = True
End With

With Worksheets("Graph").PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = True
End With

'Next
Set sh = ActiveSheet
Sheets(Array("Graphes", "Graph", "Analyses")).Select
pIni = ThisWorkbook.Path '"C:\Users\Martial\Documents" 'Si tu veux ouvrir diriger vers un répertoire particulier
Set oSh = CreateObject("Shell.Application")
On Error Resume Next
'Si tu veux voir les fichiers déjà présent, il faut rajouter + &H4000 après + &H200
Set pfile = oSh.BrowseForFolder(0&, "Sélectionnez un dossier", &H1 + &H40 + &H200, pIni)
If Not pfile Is Nothing Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pfile.items.Item.Path & "\" & Worksheets("Enregistrement").Cells(1, 3).Value & ".pdf"
End If
On Error GoTo 0
Set pIni = Nothing
Set pfile = Nothing
Set oSh = Nothing
sh.Select
Application.ScreenUpdating = -1
End Sub


Merci pour votre aide .
Cordialement
 

nicroq

XLDnaute Occasionnel
Merci kiki29,

cependant le code bloque sur le set Rg :

Sub Tst()


Dim Plage_01 As Range
Dim Plage_02 As Range
Dim Plage_03 As Range

Set Plage_01 = Worksheets("Analyses").Range(Worksheets("Analyses").Cells(1, 1), Worksheets("Analyses").Cells(40, 20))
Set Plage_02 = Worksheets("Graph").Range(Worksheets("Graph").Cells(1, 1), Worksheets("Graph").Cells(40, 20))
Set Plage_03 = Worksheets("Graphes").Range(Worksheets("Graphes").Cells(1, 1), Worksheets("Graphes").Cells(40, 20))

Dim Rg As Range
Set Rg = Application.Union(Plage_01, Plage_02, Plage_03)
Rg.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & "Test.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Set Rg = Nothing
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 198
Messages
2 086 143
Membres
103 129
dernier inscrit
Atruc81500