Macro récupération de Excel pour modifier un powerpoint [Excel et ppt 2007]

Le 01/05/2023 à 16:02

Bonjour à tous,

je souhaite récupérer des données d'un rapport excel, en fonction de ses données je vais modifier un fichier powerpoint,

pour commencer je veux que si la cellule I15 est égale à sectionneur fusible alors dans le fichier powerpoint le groupe 2 de la diapo2 soit copier dans la diapo 1 sans la modifier .

cela fonctionne jusqu'à l'ouverture du powerpoint mais il me met une erreur d'execution 424 pour la ligne Set Diapo1 = PPTPrs.Slides(1)

comment je peux faire pour connaitre le nom de la diapo 1 dans powerpoint.

je vous mets mon code ainsi que les fichiers pour aide

merci d'avance de votre aide...

Sub schema_automatique()

Dim wb As Workbook ' pour stocker le workbook
Dim ws As Worksheet ' pour stocker le worksheet
Dim ligne As Integer ' pour stocker le nombre de ligne
Dim donnee1 As String, donnee2 As String, donnee3 As String, donnee4 As String, donnee5 As String, donnee6 As String ' pour stocker les données de cellules

'ouvre boite de dialogue
Set wb = Workbooks.Open(Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx"))

'récupère les données des rapports
Set ws = wb.Sheets("Fiche armoire")
donnee1 = ws.Range("E14").Value
donnee2 = ws.Range("J14").Value
donnee3 = ws.Range("I15").Value
donnee4 = ws.Range("I17").Value
donnee5 = ws.Range("K17").Value
donnee6 = ws.Range("I19").Value

If donnee1 = "" Then donnee1 = "-"
If donnee2 = "" Then donnee2 = "-"
If donnee3 = "" Then donnee3 = "-"
If donnee4 = "" Then donnee4 = "-"
If donnee5 = "" Then donnee5 = "-"
If donnee6 = "" Then donnee6 = "-"

Dim nb_lignes As Integer ' pour stocker le nombre de lignes remplies

'récupère les données des rapports
    Set ws = wb.Sheets("Fiche armoire")

    'récupère le nombre de lignes remplies dans la plage B29:B37
Set ws = wb.Sheets("Fiche armoire")
nb_lignes = Application.WorksheetFunction.CountA(ws.Range("B29:B37"))

MsgBox ("Nombre de lignes remplies : " & nb_lignes)

        'CODE FONCTIONNE LE 11/04 A 12HR

    Dim donneesEX(1 To 9) As Variant
Dim donneesEH(1 To 9) As Variant
Dim donneesEI(1 To 9) As Variant
Dim donneesEJ(1 To 9) As Variant
Dim donneesEK(1 To 9) As Variant
Dim donneesEP(1 To 9) As Variant
Dim donneesES(1 To 9) As Variant

    For ligne = 29 To 37
        If Not IsEmpty(Range("B" & ligne)) Then
            If IsEmpty(Range("F" & ligne)) And _
                IsEmpty(Range("H" & ligne)) And _
                IsEmpty(Range("I" & ligne)) And _
                IsEmpty(Range("J" & ligne)) And _
                IsEmpty(Range("K" & ligne)) And _
                IsEmpty(Range("P" & ligne)) And _
                IsEmpty(Range("S" & ligne)) Then
                   ' Range("F" & ligne & ":S" & ligne).Value = "-"
            Else
                If Not IsEmpty(Range("F" & ligne)) Then donneesEX(ligne - 28) = Range("F" & ligne).Value
                If Not IsEmpty(Range("H" & ligne)) Then donneesEH(ligne - 28) = Range("H" & ligne).Value
                If Not IsEmpty(Range("I" & ligne)) Then donneesEI(ligne - 28) = Range("I" & ligne).Value
                If Not IsEmpty(Range("J" & ligne)) Then donneesEJ(ligne - 28) = Range("J" & ligne).Value
                If Not IsEmpty(Range("K" & ligne)) Then donneesEK(ligne - 28) = Range("K" & ligne).Value
                If Not IsEmpty(Range("P" & ligne)) Then donneesEP(ligne - 28) = Range("P" & ligne).Value
                If Not IsEmpty(Range("S" & ligne)) Then donneesES(ligne - 28) = Range("S" & ligne).Value
            End If
        End If
    Next ligne

    'Utilisation des données récupérées
    'Exemple : MsgBox donneesEX(1)

MsgBox donneesEX(1)

    'ouvrir le fichier powerpoint schéma symielec

    Dim PPTApp As Object ' pour stocker l'application PowerPoint
    Dim PPTPres As Object ' pour stocker la présentation PowerPoint

    ' ouvre l'application PowerPoint
    Set PPTApp = CreateObject("PowerPoint.Application")
    PPTApp.Visible = True

    ' ouvre la présentation PowerPoint spécifique
    Set PPTPres = PPTApp.Presentations.Open("I:\Mon Drive\symielec\schemas_automatiques\ben83.pptx")

        ' Vérifier si la variable "donnee3" est égale à "Sectionneur fusibles"
    If donnee3 = "Sectionneur fusibles" Then
        ' Récupérer les diapositives
        Set Diapo1 = PPTPrs.Slides(1)
        Set Diapo2 = PPTPrs.Slides(2)

        ' Copier le groupe 2 de la diapo 2
        Diapo2.Shapes("Groupe 2").Copy

        ' Coller le groupe copié dans la diapo 1 sans supprimer le contenu existant
        Diapo1.Shapes.PasteSpecial DataType:=ppPasteDefault
    Else
        ' Afficher un message d'erreur si l'inter frontière est mal défini dans le rapport
        MsgBox "L'inter frontière est mal défini dans le rapport."
    End If

    ' ferme la présentation PowerPoint et l'application PowerPoint
    'PPTPres.Close
    'PPTApp.Quit

End Sub
17ben83.pptx (47.65 Ko)
19recuperation-auto-pour-forum.xlsm (22.55 Ko)
17le-thoronet-pour-forum.xlsx (25.61 Ko)
Le 02/05/2023 à 14:29

Bonjour,

Vous avez une erreur de syntaxe dans la variable présentation pour instancier vos diapos.

Obligez-vous à définir systématiquement vos variables en cochant la case dans l'éditeur VBA Option - Editeur. Ensuite, le bouton débogage vous permettra de repérer ces erreurs.

En phase de développement, je vous conseille de référencer PowerPoint et de déclarer vos variables en tant que PowerPoint.Application et PowerPoint.Presentation et non en tant que variables Object. Vous bénéficierez de l'intellisens, c'est à dire qu'en tapant un point derrière vos variables vous aurez accès à toutes les méthodes propriétés et événements utilisables avec ces variables. C'est un gros gain de temps.

Lorsque votre code sera au point et si votre outil doit être exporté sur des postes équipés de différentes versions d'Office, vous pourrez passer en "late binding" et déclarer vos variables en tant qu'objet.

Option Explicit

Sub schema_automatique()

Dim Chemin As String

Dim wb As Workbook ' pour stocker le workbook
Dim ws As Worksheet ' pour stocker le worksheet
Dim ligne As Integer ' pour stocker le nombre de lignes
Dim donnee1 As String, donnee2 As String, donnee3 As String, donnee4 As String, donnee5 As String, donnee6 As String ' pour stocker les données de cellules
Dim nb_lignes As Integer ' pour stocker le nombre de lignes remplies

Dim PPTApp As PowerPoint.Application 'Object ' pour stocker l'application PowerPoint
Dim PPTPres As PowerPoint.Presentation ' pour stocker la présentation PowerPoint
Dim Diapo1 As Slide, Diapo2 As Slide

   Chemin = ThisWorkbook.Path & "\"

'ouvre boite de dialogue
Set wb = Workbooks.Open(Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx"))

'récupère les données des rapports
Set ws = wb.Sheets("Fiche armoire")
donnee1 = ws.Range("E14").Value
donnee2 = ws.Range("J14").Value
donnee3 = ws.Range("I15").Value
donnee4 = ws.Range("I17").Value
donnee5 = ws.Range("K17").Value
donnee6 = ws.Range("I19").Value

If donnee1 = "" Then donnee1 = "-"
If donnee2 = "" Then donnee2 = "-"
If donnee3 = "" Then donnee3 = "-"
If donnee4 = "" Then donnee4 = "-"
If donnee5 = "" Then donnee5 = "-"
If donnee6 = "" Then donnee6 = "-"

'récupère les données des rapports
    Set ws = wb.Sheets("Fiche armoire")

    'récupère le nombre de lignes remplies dans la plage B29:B37
Set ws = wb.Sheets("Fiche armoire")
nb_lignes = Application.WorksheetFunction.CountA(ws.Range("B29:B37"))

MsgBox ("Nombre de lignes remplies : " & nb_lignes)

        'CODE FONCTIONNE LE 11/04 A 12HR

    Dim donneesEX(1 To 9) As Variant
Dim donneesEH(1 To 9) As Variant
Dim donneesEI(1 To 9) As Variant
Dim donneesEJ(1 To 9) As Variant
Dim donneesEK(1 To 9) As Variant
Dim donneesEP(1 To 9) As Variant
Dim donneesES(1 To 9) As Variant

    For ligne = 29 To 37
        If Not IsEmpty(Range("B" & ligne)) Then
            If IsEmpty(Range("F" & ligne)) And _
                IsEmpty(Range("H" & ligne)) And _
                IsEmpty(Range("I" & ligne)) And _
                IsEmpty(Range("J" & ligne)) And _
                IsEmpty(Range("K" & ligne)) And _
                IsEmpty(Range("P" & ligne)) And _
                IsEmpty(Range("S" & ligne)) Then
                   ' Range("F" & ligne & ":S" & ligne).Value = "-"
            Else
                If Not IsEmpty(Range("F" & ligne)) Then donneesEX(ligne - 28) = Range("F" & ligne).Value
                If Not IsEmpty(Range("H" & ligne)) Then donneesEH(ligne - 28) = Range("H" & ligne).Value
                If Not IsEmpty(Range("I" & ligne)) Then donneesEI(ligne - 28) = Range("I" & ligne).Value
                If Not IsEmpty(Range("J" & ligne)) Then donneesEJ(ligne - 28) = Range("J" & ligne).Value
                If Not IsEmpty(Range("K" & ligne)) Then donneesEK(ligne - 28) = Range("K" & ligne).Value
                If Not IsEmpty(Range("P" & ligne)) Then donneesEP(ligne - 28) = Range("P" & ligne).Value
                If Not IsEmpty(Range("S" & ligne)) Then donneesES(ligne - 28) = Range("S" & ligne).Value
            End If
        End If
    Next ligne

    'Utilisation des données récupérées
    'Exemple : MsgBox donneesEX(1)

MsgBox donneesEX(1)

    'ouvrir le fichier powerpoint schéma symielec

    ' ouvre l'application PowerPoint
    Set PPTApp = CreateObject("PowerPoint.Application")
    PPTApp.Visible = True

    ' ouvre la présentation PowerPoint spécifique
    'Set PPTPres = PPTApp.Presentations.Open("I:\Mon Drive\symielec\schemas_automatiques\ben83.pptx")
    Set PPTPres = PPTApp.Presentations.Open(Chemin & "ben83.pptx")

        ' Vérifier si la variable "donnee3" est égale à "Sectionneur fusibles"
    If donnee3 = "Sectionneur fusibles" Then
        ' Récupérer les diapositives

        Set Diapo1 = PPTPres.Slides(1)
        Set Diapo2 = PPTPres.Slides(2)

        ' Copier le groupe 2 de la diapo 2
        Diapo2.Shapes("Groupe 2").Copy

        ' Coller le groupe copié dans la diapo 1 sans supprimer le contenu existant
        Diapo1.Shapes.PasteSpecial DataType:=ppPasteDefault
    Else
        ' Afficher un message d'erreur si l'inter frontière est mal défini dans le rapport
        MsgBox "L'inter frontière est mal défini dans le rapport."
    End If

    ' ferme la présentation PowerPoint et l'application PowerPoint
    'PPTPres.Close
    'PPTApp.Quit

End Sub
24recuperation-auto-pour-forum.xlsm (25.96 Ko)
Le 27/01/2024 à 20:37

Merci beaucoup pour la réponse, je me suis inspiré de ton aide et mon fichier fonctionne très bien

Rechercher des sujets similaires à "macro recuperation modifier powerpoint ppt 2007"