Exporter Excel vers PPT avec VBA
Bonjour,
A partir d'un fichier excel, je souhaite créer une présentation PPT.
Je suis novice en VBA, j'ai créé un code grâce à un tuto et je ne comprends pas d'où l'erreur vient après des heures de recherches.
Voici le message d'erreur:
Un problème avec Slides.Add mais je ne vois pas pourquoi.
Voici mon code, l'erreur provient de la ligne ne gras:
Sub exporterVersPowerPoint()
'1 récupérer les adresses des pages d'impression
Dim plages As String: plages = ""
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(Cells(debut, 1), Cells(ligneSaut - 1, derniereColonne)).Address & "-"
debut = ligneSaut
Next
ligneFin = ActiveSheet.UsedRange.Rows.Count
plages = plages & Range(Cells(debut, 1), Cells(ligneFin - 1, derniereColonne)).Address & "-"
plages = Left(plages, Len(plages) - 1)
End If
End With
'2 exporter vers ppt
Dim oPowerpoint As Object
Set oPowerpoint = CreateObject("Powerpoint.application")
Dim oDiaporama As Object
Set oDiaporama = oPowerpoint.Presentations.Add
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:=ppPasteEnhancedMetafile
idDiapo = idDiapo + 1
Next
End Sub
Je vous remercie pour votre aide !
Olivia
bonsoir,
ppLayoutBlank n'est pas défini et reçoit par défaut la valeur 0, qui n'est pas une valeur correcte pour le paramètre Layout de la méthode slides.add
utilise ceci
Set oDiapositive = oDiaporama.Slides.Add(Index:=idDiapo, Layout:=12)au lieu de
Set oDiapositive = oDiaporama.Slides.Add(Index:=idDiapo, Layout:=ppLayoutBlank) ou
définis une variable ppLayoutBlank et assigne-lui la valeur 12
ou
ajoute une référence à la bibliothèque powerpoint via le menu outils dans l'éditeur VBA.
Bonjour
j'ai testé en remplaçant par Set oDiapositive = oDiaporama.Slides.Add(Index:=idDiapo, Layout:=12)
et cela fonctionne ; )
merci pour votre aide.
Olivia
Maintenant que ma macro fonctionne je souhaiterai appliquer un masque particulier (propre à l'entreprise dans laquelle je travaille).
Est-ce possible d'appliquer un masque en particulier à l'ouverture du PPT ? Si oui que dois-je apporter à mon code ? merci !!!
Voici mon code complet:
Sub exporterVersPowerPoint()
'1 récupérer les adresses des pages d'impression
Dim plages As String: plages = ""
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(Cells(debut, 1), Cells(ligneSaut - 1, derniereColonne)).Address & "-"
debut = ligneSaut
Next
ligneFin = ActiveSheet.UsedRange.Rows.Count
plages = plages & Range(Cells(debut, 1), Cells(ligneFin - 1, derniereColonne)).Address & "-"
plages = Left(plages, Len(plages) - 1)
End If
End With
'2 exporter vers ppt
Dim oPowerpoint As Object
Set oPowerpoint = CreateObject("Powerpoint.application")
Dim oDiaporama As Object
Set oDiaporama = oPowerpoint.Presentations.Add
idDiapo = 1
For Each plage In Split(plages, "-")
Dim oDiapositive As Object
Set oDiapositive = oDiaporama.Slides.Add(Index:=idDiapo, Layout:=12)
ActiveSheet.Range(plage).Copy
oDiaporama.Slides(idDiapo).Shapes.PasteSpecial (ppPasteEnhancedMetafile)
idDiapo = idDiapo + 1
Next
End Sub
je vous remercie pour votre aide
bonjour,
à tester après avoir adapté le code à l'endroit indiqué
merci à l'avenir de mettre ton code en utilisant le bouton </>
Sub exporterVersPowerPoint()
'1 récupérer les adresses des pages d'impression
Dim plages As String: plages = ""
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(Cells(debut, 1), Cells(ligneSaut - 1, derniereColonne)).Address & "-"
debut = ligneSaut
Next
ligneFin = ActiveSheet.UsedRange.Rows.Count
plages = plages & Range(Cells(debut, 1), Cells(ligneFin - 1, derniereColonne)).Address & "-"
plages = Left(plages, Len(plages) - 1)
End If
End With
'2 exporter vers ppt
Dim oPowerpoint As Object
Set oPowerpoint = CreateObject("Powerpoint.application")
Dim oDiaporama As Object
Set oDiaporama = oPowerpoint.Presentations.Add
oDiaporama.applytemplate "d:\chemin\fichier de référence avec le template souhaité.pptx" '<----------- nom de fichier à adapter
idDiapo = 1
For Each plage In Split(plages, "-")
Dim oDiapositive As Object
Set oDiapositive = oDiaporama.Slides.Add(Index:=idDiapo, Layout:=12)
ActiveSheet.Range(plage).Copy
oDiaporama.Slides(idDiapo).Shapes.PasteSpecial (ppPasteEnhancedMetafile)
idDiapo = idDiapo + 1
Next
End Subvaleurs possibles pour le paramètre layout
https://learn.microsoft.com/en-us/office/vba/api/powerpoint.ppslidelayout
Bonjour
Merci pour votre réponse. Malheureusement cela ne fonctionne pas cela continue à m'ouvrir un fichier vierge sans masque.
Avez-vous une autre solution?
merci.
C'est noté pour le bouton </>