Problème ordre diapositive
Bonjour à tous, j'utilise un code qui permet de pouvoir copier des parties d'une feuille Excel vers un powerpoint en format image. J'ai en grande partie utiliser le code présenté dans la vidéo suivante : https://www.youtube.com/watch?v=91ySaeKguSA
Le souci est que quand je l'active, la macro fonctionne mais l'ordre des diapositives dans mon ppt est inversé (la première devient la dernière et vice-versa)
Voici mon code :
Sub ExporterVersPpt()
' 1 récupérer les adresses des pages d'impression
Dim Plages As String: Plages = ""
Application.CutCopyMode = False 'vide le presse papier
With ActiveSheet.HPageBreaks
If .Count = 0 Then
Plages = ActiveSheet.UsedRange.Address
Else
Debut = 1
For i = 1 To .Count
LigneSaut = .Item(i).Location.Row
DerniereColonne = ActiveSheet.UsedRange.Columns.Count
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 - 1, DerniereColonne)).Address & "-"
Plages = Left(Plages, Len(Plages) - 1)
End If
End With
' 2 exporter vers PowerPoint
Dim oPowerPoint As Object
Set oPowerPoint = CreateObject("Powerpoint.Application")
Dim oDiaporama As Object
Set oDiaporama = oPowerPoint.Presentations.Add
oDiaporama.PageSetup.SlideSize = 3
Dim idDiapo As Integer
idDiapo = 1
For Each Plage In Split(Plages, "-")
Dim oDiapositive As Object
Set oDiapositive = oDiaporama.Slides.Add(Index:=idDiapo, Layout:=ppLayoutBlank)
ActiveSheet.Range(Plage).Copy
oDiaporama.Slides(idDiapo).Shapes.PasteSpecial DataType:=2
'Mettre l'image à la dimension de la page
oDiaporama.Slides(idDiapo).Shapes(1).ScaleWidth 1, msoTrue, msoScaleFromMiddle
oDiaporama.Slides(idDiapo).Shapes(1).ScaleHeight 1, msoTrue, msoScaleFromMiddle
' calcul du coefficient d'agrandissement
Dim agrandissement As Double
If oDiaporama.Slides(idDiapo).Shapes(1).Height > oDiaporama.Slides(idDiapo).Shapes(1).Width Then
agrandissement = oDiaporama.PageSetup.SlideHeight / oDiaporama.Slides(idDiapo).Shapes(1).Height
Else
agrandissement = oDiaporama.PageSetup.SlideWidth / oDiaporama.Slides(idDiapo).Shapes(1).Width
End If
' Mise-à-l'échelle de l'image
oDiaporama.Slides(idDiapo).Shapes(1).ScaleWidth agrandissement, msoTrue, msoScaleFromMiddle
oDiaporama.Slides(idDiapo).Shapes(1).ScaleHeight agrandissement, msoTrue, msoScaleFromMiddle
idDiapo = iDiapo + 1
Next
Application.CutCopyMode = False 'vide le presse papier
End Sub
Bonjour
Présente ton diaporama en commençant par la fin !
Non plus sérieusement, regarde ton code au niveau de
For Each Plage In Split(Plages, "-")
Il faut trouver le moyen d'inverser cette boucle !
Merci de ta réponse Gli73
With ActiveSheet.HPageBreaks
If .Count = 0 Then
Et après à la fin d'avancer à rebours en faisant :
idDiapo = idDiapo - 1
Mais ça marche pas :/
Bonjour
A ma connaissance la boucle For Each/Next ne permet de compter à rebours !
Cependant tu peux le faire avec une boucle For/Next "classique" de cette manière
For compteurRebours = 10 To 1 [color=#0000FF][u]Step -1
[/u][/color]'...code utile
Next
Le "complément" STEP permet de régler le "pas" de la boucle ET il peut être négatif, donc pour compter à rebours !
à adapter à ton cas !