POWERPOINT diapo non active

Le 25/03/2023 à 20:55

Bonjour je voudrais créer un schéma élec à partir de powerpoint.

pour l'instant j'ai 1 diapo vierge et 3 diapo avec des parties de schéma différentes, j'ai créer ce code :

Sub CopierSchéma()
    Dim Diapo As Integer
    Diapo = InputBox("Entrez le numéro de la diapositive dont vous souhaitez copier le schéma.")
    If Diapo < 2 Or Diapo > 4 Then
        MsgBox "Numéro de diapositive non valide. Veuillez entrer un nombre compris entre 2 et 4."
    Else
        'Vérifie que la diapositive est active
        If ActiveWindow.View.Slide.SlideIndex <> Diapo Then
            MsgBox "La diapositive sélectionnée n'est pas active. Veuillez activer la diapositive et réessayer."
            Exit Sub
        End If

        'Sélectionne le groupe de formes dans la diapositive sélectionnée
        'Remplacez "Groupe de formes" par le nom exact du groupe de formes que vous souhaitez copier
        ActivePresentation.Slides(Diapo).Shapes.Range(Array("Groupe 2")).Select

        'Copie le groupe de formes de la diapositive sélectionnée
        ActiveWindow.selection.Copy

        'Colle le groupe de formes dans la première diapositive
        ActivePresentation.Slides(1).Shapes.Paste

        'Déplace le groupe de formes collé en haut au milieu avec un décalage de 1 cm
        With ActivePresentation.Slides(1).Shapes(ActivePresentation.Slides(1).Shapes.Count)
            .Top = ActivePresentation.PageSetup.SlideHeight / 2 - .Height / 2 - 28.35 '28.35 est la valeur de 1 cm en points
            .Left = ActivePresentation.PageSetup.SlideWidth / 2 - .Width / 2
        End With
    End If
End Sub

quand je teste ça me dit:

la diapositive sélectionnée n'est pas active. Veuillez activer la diapositive et réessayer.

Pourtant quand je fais F5 ça me fait bien défiler les 4 diapo... je vous joins le fichier si vous avez une piste :)

6presentation3.pptm (46.19 Ko)
merci d'avance :D
Le 26/03/2023 à 10:52

Bonjour,

Je procèderai plutôt comme ceci:

Sub CopierSchéma()
    Dim Diapo As Integer
    Diapo = InputBox("Entrez le numéro de la diapositive dont vous souhaitez copier le schéma.")
    If Diapo < 2 Or Diapo > 4 Then
        MsgBox "Numéro de diapositive non valide. Veuillez entrer un nombre compris entre 2 et 4."
    Else
        'Vérifie que la diapositive existe, si c'est le cas elle est sélectionnée, sinon on quite le programme
        On Error Resume Next
        ActivePresentation.Slides(Diapo).Select
        If Err.Number <> 0 Then
            MsgBox "La diapositive sélectionnée n'est pas active. Veuillez activer la diapositive et réessayer."
            Exit Sub
        End If
        On Error GoTo 0
        'Sélectionne le groupe de formes dans la diapositive sélectionnée
        'Remplacez "Groupe de formes" par le nom exact du groupe de formes que vous souhaitez copier
        ActivePresentation.Slides(Diapo).Shapes.Range(Array("Groupe 2")).Select

        'Copie le groupe de formes de la diapositive sélectionnée
        ActiveWindow.selection.Copy

        'Colle le groupe de formes dans la première diapositive
        ActivePresentation.Slides(1).Shapes.Paste

        'Déplace le groupe de formes collé en haut au milieu avec un décalage de 1 cm
        With ActivePresentation.Slides(1).Shapes(ActivePresentation.Slides(1).Shapes.Count)
            .Top = ActivePresentation.PageSetup.SlideHeight / 2 - .Height / 2 - 28.35 '28.35 est la valeur de 1 cm en points
            .Left = ActivePresentation.PageSetup.SlideWidth / 2 - .Width / 2
        End With
    End If
End Sub

Cdlt

Le 26/03/2023 à 14:49

Je vais essayer ce soir. Merci à toi. Ça va régler le pb des diapos non active ?

Le 26/03/2023 à 18:10

merci ça a marché mais ça ne marche que une fois, ensuite ça me redit que la diapo n'est pas active,

merci d'avance pour votre aide

Le 27/03/2023 à 01:09

Bonjour,

Je ne comprends pas, j'ai fait plusieurs essais et je ne rencontre pas de problème.

Afin que je puisse reproduire le problème et obtenir le même message que vous, expliquez-moi quelles sont les actions que vous faites.

Cdlt

Le 31/03/2023 à 21:58

Bonjour Arturo,

je viens d'essayer avec ce code:

Sub schema()

Dim interf As String

choixgeneral:
interf = InputBox("De quel type est l'IF? IF1 / IF3 / Dd1")
If Not (interf = "IF1" Or interf = "IF3" Or interf = "Dd1") Then
MsgBox ("Erreur de saisie")
GoTo choixgeneral:
'Else: MsgBox (interf)

End If

' copier la diapositive souhaitée en fonction de la saisie de l'utilisateur
Dim ppt As Presentation
Set ppt = ActivePresentation

'créer une variable pour stocker la diapositive à copier
Dim diapositive As Slide

If interf = "IF1" Then
'copier la diapositive 2
Set diapositive = ppt.Slides(2)
ElseIf interf = "IF3" Then
'copier la diapositive 3
Set diapositive = ppt.Slides(3)
ElseIf interf = "Dd1" Then
'copier la diapositive 4
Set diapositive = ppt.Slides(4)
End If

' Coller la diapositive copiée dans la première diapositive sans supprimer le contenu existant
    diapositive.Copy
    ActiveWindow.View.Paste
End Sub

ce me mets ce message d'erreur

image

et dans le débogage j'ai

 ActiveWindow.View.Paste

surligné en jaune

est ce que cela te parle?, j'ai powerpoint 2007

Le 31/03/2023 à 21:59

je crois que shapes ne fonctionne pas dans ma version de 2007

Le 01/04/2023 à 06:36

Bonjour,

Moi aussi je suis en 2007.

Il ne faut pas copier la diapo, mais son contenu et en entrant dans les détails, on voit que les images s'appellent "Groupe 2".

J'ai bien compris ce que vous voulez faire, reconstruire un schéma électrique à la demande sur la diapo 1. J'ai fait des essais et ça marche bien, il suffit que chaque dessin de chaque diapo soit au bon endroit dans la diapo, ainsi lors du collage, ils prendront tous leur place réelle sans affecter le contenu déjà existant de la diapo 1.

Le code:

Sub Schema()
    Dim Interf As String
    Dim Ppt As Presentation
    Dim Diapositive As Long 'créer une variable pour stocker la diapositive à copier

ChoixGeneral:
    Interf = InputBox("De quel type est l'IF? IF1 / IF3 / Dd1")
    If Not (Interf = "IF1" Or Interf = "IF3" Or Interf = "Dd1") Then
        MsgBox ("Erreur de saisie")
        GoTo ChoixGeneral
    End If
    ' copier la diapositive souhaitée en fonction de la saisie de l'utilisateur
    Set Ppt = ActivePresentation
    If Interf = "IF1" Then
            Diapositive = 2        'copier la diapositive 2
        ElseIf Interf = "IF3" Then
            Diapositive = 3        'copier la diapositive 3
        ElseIf Interf = "Dd1" Then
            Diapositive = 4        'copier la diapositive 4
    End If

    ' Coller la diapositive copiée dans la première diapositive sans supprimer le contenu existant
    With Ppt
        .Slides(Diapositive).Shapes("Groupe 2").Copy
        .Slides(1).Shapes.Paste
    End With
End Sub

le fichier en exemple:

10ben83130-presentation3.pptm (53.70 Ko)

Cdlt

Le 01/04/2023 à 10:34

AU TOP!!

merci beaucoup, je vais essayer de faire des diapos plus petites et essayer de les coller au position que je souhaite dans la 1ere diapo.

je reviendrai peut être si je galère, merci encore !

Le 02/04/2023 à 17:42

j'ai bien avancé,

Sub Schema()
    Dim Interf As String
    Dim Ppt As Presentation
    Dim Diapositive As Long 'créer une variable pour stocker la diapositive à copier

ChoixGeneral:
    Interf = InputBox("De quel type est l'Interfrontière ?" & vbCrLf & "IF1 / IF3 / Dd21 / Dd43 / D21 /D43")
     If Interf = "" Then Exit Sub ' Sortir de la fonction si l'utilisateur clique sur "Annuler"
    If Not (Interf = "IF1" Or Interf = "IF3" Or Interf = "Dd21" Or Interf = "Dd43" Or Interf = "D21" Or Interf = "D43") Then
        MsgBox ("Erreur de saisie")
        GoTo ChoixGeneral
    End If
    ' copier la diapositive souhaitée en fonction de la saisie de l'utilisateur
    Set Ppt = ActivePresentation
    If Interf = "IF1" Then
            Diapositive = 2        'copier la diapositive 2
        ElseIf Interf = "IF3" Then
            Diapositive = 3        'copier la diapositive 3
        ElseIf Interf = "Dd21" Then
            Diapositive = 4        'copier la diapositive 4
        ElseIf Interf = "Dd43" Then
            Diapositive = 5
        ElseIf Interf = "D21" Then
            Diapositive = 6
        ElseIf Interf = "D43" Then
            Diapositive = 7
    End If

    ' Coller la diapositive copiée dans la première diapositive sans supprimer le contenu existant
    With Ppt
        .Slides(Diapositive).Shapes("Groupe 2").Copy
        .Slides(1).Shapes.Paste
    End With

    'choix du nombres de départ
Choixgeneral3:
    Dim NbDepartEP As Long
    Dim i As Long
    NbDepartEP = InputBox("Combien de départs EP  ? (1-6)")
    If Interf = "" Then Exit Sub ' Sortir de la fonction si l'utilisateur clique sur "Annuler"
        If NbDepartEP < 1 Or NbDepartEP > 6 Then
        MsgBox ("Nombre de départs EP invalide.")
        GoTo Choixgeneral3
    End If

    'CHOIX DES DEPART EP
    For i = 1 To NbDepartEP
ChoixGeneral2:
    Interf = InputBox("De quel type est le départ EP ? " & vbCrLf & "IF1 / IF3 / Dd21 / Dd43 / D21 /D43" & vbCrLf & "I20 / I40")
     If Interf = "" Then Exit Sub ' Sortir de la fonction si l'utilisateur clique sur "Annuler"
    If Not (Interf = "IF1" Or Interf = "IF3" Or Interf = "Dd21" Or Interf = "Dd43" Or Interf = "D21" Or Interf = "D43" Or Interf = "I20" Or Interf = "I40") Then
        MsgBox ("Erreur de saisie")
        GoTo ChoixGeneral2

    End If
    Next i
    ' copier la diapositive souhaitée en fonction de la saisie de l'utilisateur
    Set Ppt = ActivePresentation
    If Interf = "IF1" Then
            Diapositive = 8
        ElseIf Interf = "IF3" Then
            Diapositive = 9
        ElseIf Interf = "Dd21" Then
            Diapositive = 10
        ElseIf Interf = "Dd43" Then
            Diapositive = 11
        ElseIf Interf = "D21" Then
            Diapositive = 12
        ElseIf Interf = "D43" Then
            Diapositive = 13
        ElseIf Interf = "I20" Then
            Diapositive = 14
        ElseIf Interf = "I40" Then
            Diapositive = 14
    End If

    ' Coller la diapositive copiée dans la première diapositive sans supprimer le contenu existant
    With Ppt
        .Slides(Diapositive).Shapes("Group 3").Copy
        .Slides(1).Shapes.Paste

   ' choix du positionnement de la diapositive en fonction du numéro de départ EP
Select Case i
Case 1
.Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 125
.Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 157
Case 2
.Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
.Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
.Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 157
Case 3
.Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 125
.Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 360
.Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
.Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 157
Case 4
.Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Left = 125
.Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 600
.Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
.Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 350
.Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
.Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 350
Case 5
.Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Left = 125
.Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Left = 360
.Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 600
.Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
.Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 350
.Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
.Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 350
Case 6
.Slides(1).Shapes(.Slides(1).Shapes.Count - 5).Left = 125
.Slides(1).Shapes(.Slides(1).Shapes.Count - 5).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Left = 125
.Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Left = 360
.Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 600
.Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
.Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
.Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 350
.Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
.Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 350
End Select

    End With
End Sub

Le code ne fonctionne pas, à mon avis c'est parceque je n'enregistre pas les réponses de l'utilisateur, il faudrait enregistrer et après faire une boucle pour mettre les 3 choix par exemple...

Si vous avez une piste car je sature lol

merci d'avance

Le 02/04/2023 à 19:18

Bonsoir,

Difficile de vous répondre, c'est assez spécifique et je ne vois pas où vous voulez en venir. il faudrait que vous me disiez les actions que vous faites (parmi les 3 choix) et quel est le résultat attendu.

Vous pouvez aussi faire toujours le code en pas à pas et repérer à partir de quelle ligne cela ne réagit pas comme vous le souhaiteriez. Cela me permettrai de comprendre pour la suite des évènements.

Cdlt

Le 03/04/2023 à 08:06

Bonjour,

au niveau du choix du nombre de départ EP, l'utilisateur choisit combien il a de départ EP à rentrer dans le schéma, de 1 à 6.

En fonction de ce choix il va devoir rentrer autant de fois le type de départ EP, dans le code i.

Du coup s'il choisit 4 fois, après il a 4 boxes qui lui demande le type d'EP, il peut choisir entre 8 choix...

après ça colle comme dans la diapo comme pour ce qu'on a fait au début.

Vu qu'il peut y avoir de 1 à 6 départs le positionnement des départ EP ne va pas être le même en fonction du nombre choisi.

Du coup je pense qu'il manque la mémorisation des 4 choix ( par exemple) que l'utilisateur a fait dans la partie choix des départs EP.

Le 03/04/2023 à 08:27

Avec le fichier dont je dispose, je ne peux pas faire des essais corrects, je n'ai que 3 diapos et elles font parti du groupe2, or dans votre code, je vois 14 diapos du groupe3, de ce fait, je suis très limité pour faire des essais, il me faudrait de dernier fichier, ci possible.

Question, il n'y a pas une erreur là?

ben83130

Cdlt

Le 03/04/2023 à 21:45

tu as l'œil, j'ai modifié, ci joint un fichier type

si tu as une piste à suivre pour enregistrer les choix de l'utilisateur je suis preneur

5ben83.pptm (60.37 Ko)
Le 04/04/2023 à 04:47

Bonjour,

Si j'ai bien compris:

Sub Schema()
    Dim Interf As String
    Dim Ppt As Presentation
    Dim Diapositive As Long 'créer une variable pour stocker la diapositive à copier

ChoixGeneral:
    Interf = InputBox("De quel type est l'Interfrontière ?" & vbCrLf & "IF1 / IF3 / Dd21 / Dd43 / D21 /D43")
    If Interf = "" Then Exit Sub ' Sortir de la fonction si l'utilisateur clique sur "Annuler"
    If Not (Interf = "IF1" Or Interf = "IF3" Or Interf = "Dd21" Or Interf = "Dd43" Or Interf = "D21" Or Interf = "D43") Then
        MsgBox ("Erreur de saisie")
        GoTo ChoixGeneral
    End If
    ' copier la diapositive souhaitée en fonction de la saisie de l'utilisateur
    Set Ppt = ActivePresentation
    If Interf = "IF1" Then
            Diapositive = 2        'copier la diapositive 2
        ElseIf Interf = "IF3" Then
            Diapositive = 3        'copier la diapositive 3
        ElseIf Interf = "Dd21" Then
            Diapositive = 4        'copier la diapositive 4
        ElseIf Interf = "Dd43" Then
            Diapositive = 5
        ElseIf Interf = "D21" Then
            Diapositive = 6
        ElseIf Interf = "D43" Then
            Diapositive = 7
    End If

    ' Coller la diapositive copiée dans la première diapositive sans supprimer le contenu existant
    With Ppt
        .Slides(Diapositive).Shapes("Groupe 2").Copy
        .Slides(1).Shapes.Paste
    End With

    'choix du nombres de départ
Choixgeneral3:
    Dim NbDepartEP As Long
    Dim i As Long
    NbDepartEP = InputBox("Combien de départs EP  ? (1-6)")
    If Interf = "" Then Exit Sub ' Sortir de la fonction si l'utilisateur clique sur "Annuler"
        If NbDepartEP < 1 Or NbDepartEP > 6 Then
        MsgBox ("Nombre de départs EP invalide.")
        GoTo Choixgeneral3
    End If

    'CHOIX DES DEPARTS EP
    For i = 1 To NbDepartEP
ChoixGeneral2:
        Interf = InputBox("De quel type est le départ EP ? " & vbCrLf & "IF1 / IF3 / Dd21 / Dd43 / D21 /D43" & vbCrLf & "I20 / I40")
        If Interf = "" Then Exit Sub ' Sortir de la fonction si l'utilisateur clique sur "Annuler"
        If Not (Interf = "IF1" Or Interf = "IF3" Or Interf = "Dd21" Or Interf = "Dd43" Or Interf = "D21" Or Interf = "D43" Or Interf = "I20" Or Interf = "I40") Then
            MsgBox ("Erreur de saisie")
            GoTo ChoixGeneral2
        Else
            ' copier la diapositive souhaitée en fonction de la saisie de l'utilisateur
            Set Ppt = ActivePresentation
            If Interf = "IF1" Then
                    Diapositive = 8
                ElseIf Interf = "IF3" Then
                    Diapositive = 9
                ElseIf Interf = "Dd21" Then
                    Diapositive = 10
                ElseIf Interf = "Dd43" Then
                    Diapositive = 11
                ElseIf Interf = "D21" Then
                    Diapositive = 12
                ElseIf Interf = "D43" Then
                    Diapositive = 13
                ElseIf Interf = "I20" Then
                    Diapositive = 14
                ElseIf Interf = "I40" Then
                    Diapositive = 15
            End If

            ' Coller la diapositive copiée dans la première diapositive sans supprimer le contenu existant
            With Ppt
                .Slides(Diapositive).Shapes("Group 3").Copy
                .Slides(1).Shapes.Paste
                ' choix du positionnement de la diapositive en fonction du numéro de départ EP
                Select Case i
                    Case 1
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 157
                    Case 2
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 157
                    Case 3
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 360
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 157
                    Case 4
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 350
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 350
                    Case 5
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Left = 360
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 350
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 350
                    Case 6
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 5).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 5).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Left = 360
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 350
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 350
                End Select
            End With
        End If
    Next i
End Sub

Attention, lors des essais, j'ai pris comme départ Ep "D21", or il ne se trouve pas dans le groupe 3, ce qui plante la macro, corrigez ce point.

Cdlt

Le 04/04/2023 à 13:44

re, tu es au top, je ne comprends pas où dans le code il y a la mémorisation du choix des EP ?

Le 04/04/2023 à 14:13

Je viens de comprendre, pas besoin de mémoriser, il les place au bon endroit à chaque fois !!

Le 08/04/2023 à 13:17

Bonjour :)

ce que j'essaie de faire c'est d'aligner les départs EP, à l'inter frontière utilisé en premier choix.

Mon souci c'est que dans les choix des départs EP la barre du haut (Line400) qui doit être parfaitement aligné n'est pas toujours dans la même position dans le groupe Group3.

du coup l'alignement n'est pas bon, donc juste pour le cas 1 départ EP choisi j'ai modifié le code comme ceci:

Sub Schema()
    Dim Interf As String
    Dim Ppt As Presentation
    Dim Diapositive As Long 'créer une variable pour stocker la diapositive à copier

ChoixGeneral:
    Interf = InputBox("De quel type est l'Interfrontière ?" & vbCrLf & "IF1 / IF3 / Dd21 / Dd43 / D21 /D43")
    If Interf = "" Then Exit Sub ' Sortir de la fonction si l'utilisateur clique sur "Annuler"
    If Not (Interf = "IF1" Or Interf = "IF3" Or Interf = "Dd21" Or Interf = "Dd43" Or Interf = "D21" Or Interf = "D43") Then
        MsgBox ("Erreur de saisie")
        GoTo ChoixGeneral
    End If
    ' copier la diapositive souhaitée en fonction de la saisie de l'utilisateur
    Set Ppt = ActivePresentation
    If Interf = "IF1" Then
            Diapositive = 2        'copier la diapositive 2
        ElseIf Interf = "IF3" Then
            Diapositive = 3        'copier la diapositive 3
        ElseIf Interf = "Dd21" Then
            Diapositive = 4        'copier la diapositive 4
        ElseIf Interf = "Dd43" Then
            Diapositive = 5
        ElseIf Interf = "D21" Then
            Diapositive = 6
        ElseIf Interf = "D43" Then
            Diapositive = 7
    End If

    ' Coller la diapositive copiée dans la première diapositive sans supprimer le contenu existant
    With Ppt
        .Slides(Diapositive).Shapes("Groupe 2").Copy
        .Slides(1).Shapes.Paste
    End With

    'choix du nombres de départ
Choixgeneral3:
    Dim NbDepartEP As Long
    Dim i As Long
    NbDepartEP = InputBox("Combien de départs EP  ? (1-6)")
    If Interf = "" Then Exit Sub ' Sortir de la fonction si l'utilisateur clique sur "Annuler"
        If NbDepartEP < 1 Or NbDepartEP > 6 Then
        MsgBox ("Nombre de départs EP invalide.")
        GoTo Choixgeneral3
    End If

    'CHOIX DES DEPARTS EP
    For i = 1 To NbDepartEP
ChoixGeneral2:
        Interf = InputBox("De quel type est le départ EP ? " & vbCrLf & "IF1 / IF3 / Dd21 / Dd43 / D21 /D43" & vbCrLf & "I20 / I40")
        If Interf = "" Then Exit Sub ' Sortir de la fonction si l'utilisateur clique sur "Annuler"
        If Not (Interf = "IF1" Or Interf = "IF3" Or Interf = "Dd21" Or Interf = "Dd43" Or Interf = "D21" Or Interf = "D43" Or Interf = "I20" Or Interf = "I40") Then
            MsgBox ("Erreur de saisie")
            GoTo ChoixGeneral2
        Else
            ' copier la diapositive souhaitée en fonction de la saisie de l'utilisateur
            Set Ppt = ActivePresentation
            If Interf = "IF1" Then
                    Diapositive = 8
                ElseIf Interf = "IF3" Then
                    Diapositive = 9
                ElseIf Interf = "Dd21" Then
                    Diapositive = 10
                ElseIf Interf = "Dd43" Then
                    Diapositive = 11
                ElseIf Interf = "D21" Then
                    Diapositive = 12
                ElseIf Interf = "D43" Then
                    Diapositive = 13
                ElseIf Interf = "I20" Then
                    Diapositive = 14
                ElseIf Interf = "I40" Then
                    Diapositive = 15
            End If

            ' Coller la diapositive copiée dans la première diapositive sans supprimer le contenu existant
            With Ppt
                .Slides(Diapositive).Shapes("Group 3").Copy
                .Slides(1).Shapes.Paste

                ' Trouver l'objet Line400 dans le groupe 3
                Dim Line400 As Shape
                Set Line400 = group.GroupItems("Line400")
                Dim newLeft As Double
                Dim newTop As Double

                ' choix du positionnement de la diapositive en fonction du numéro de départ EP
                Select Case i
                    Case 1
                newLeft = 125 ' Nouvelle position horizontale de l'objet
                newTop = 157 ' Nouvelle position verticale de l'objet
                Line400.Left = newLeft
                Line400.Top = newTop
                    Case 2
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 157
                    Case 3
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 360
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 157
                    Case 4
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 350
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 350
                    Case 5
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Left = 360
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 350
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 350
                    Case 6
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 5).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 5).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 4).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Left = 360
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 3).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 2).Top = 157
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Left = 125
                        .Slides(1).Shapes(.Slides(1).Shapes.Count - 1).Top = 350
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Left = 600
                        .Slides(1).Shapes(.Slides(1).Shapes.Count).Top = 350
                End Select
            End With
        End If
    Next i
End Sub

et il me dit erreur, objet requis au moment du choix du départ EP...

au préalable j'ai bien nommer Line400 chaque ligne dans Group3

Si vous aviez une piste

Le 08/04/2023 à 13:29

Bonjour,

Comme précédemment, dites-moi les actions (sélections) que vous faites afin que je puisse reproduire le problème.

Edit OK , j'ai vu, mais vous faites référence à des lignes que je n'ai pas sur le précédent fichier, là encore, il me faudrait un fichier qui se rapproche du fichier réel sans dévoiler des données confidentielles.

Le 08/04/2023 à 14:06

Merci encore pour ton aide,

j'ai simplifier le schéma pour ne prendre que ce que j'ai tester et après je ferai le changement.

si tu as la solution c'est top sinon je continue à chercher lol

2test-deplacement-ep.pptm (42.02 Ko)
Rechercher des sujets similaires à "powerpoint diapo active"