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
| Option Explicit
'--- Référence: Microsoft PowerPoint xx.x Object Library
Sub ExporterVersPowerpoint()
'--- Partie 1: Récupérer les adresses des pages dimpression
Dim plages As String, nombreSautDePage As Long, ligneSaut As Long
Dim derniereColonne As Long, debut As Long, ligneFin As Long, i As Integer
plages = ""
With ActiveSheet.HPageBreaks
nombreSautDePage = .Count
derniereColonne = ActiveSheet.UsedRange.Columns.Count
If nombreSautDePage = 0 Then
plages = ActiveSheet.UsedRange.Address
Else
debut = 1
For i = 1 To .Count
ligneSaut = .Item(i).Location.Row
plages = plages & Range(ActiveSheet.Cells(debut, 1), ActiveSheet.Cells(ligneSaut - 1, derniereColonne)).Address & "-"
debut = ligneSaut
Next
ligneFin = ActiveSheet.UsedRange.Rows.Count
plages = plages & Range(ActiveSheet.Cells(debut, 1), ActiveSheet.Cells(ligneFin, derniereColonne)).Address
End If
End With
Debug.Print plages
'--- Partie 2: Exporter chacune de ces zones vers une présentation PowerPoint
Dim oPowerPoint As Object, oDiaporama As Object
Dim plage As Variant, diapositive As Object, idDiapo As Integer, oShape As Object
Set oPowerPoint = CreateObject("Powerpoint.application")
Set oDiaporama = oPowerPoint.Presentations.Add
idDiapo = 1
For Each plage In Split(plages, "-")
Set diapositive = oDiaporama.Slides.Add(Index:=idDiapo, Layout:=ppLayoutBlank)
ActiveSheet.Range(plage).Copy
oDiaporama.Slides(idDiapo).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set oShape = diapositive.Shapes(diapositive.Shapes.Count)
oShape.Left = 30
oShape.Top = 60
idDiapo = idDiapo + 1
Next
oPowerPoint.Visible = True
oPowerPoint.Activate
Application.CutCopyMode = False
Set oShape = Nothing
Set diapositive = Nothing
Set oDiaporama = Nothing
Set oPowerPoint = Nothing
End Sub |
Partager