Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Nouveau Candidat au Club
    MACRO PPT Insérer une image placée dans un fichier en fonction d'un texte sélectionné sur la diapo
    Bonjour à tous,

    Je vous écris afin de vous demander votre aide !
    Je cherche désespérément à créer une macro sur powerpoint afin d'insérer des images automatiquement dans une diapo sur laquelle un texte serait sélectionné.
    Ce texte serait en fait une référence du type "086542" et je voudrais que en actionnant la macro : une image nommée "086542" soit insérée (elle est placée sur l'ordinateur dans un fichier type "P:\Direction Retail\CROQUIS\" )


    J'ai réussi à faire cette macro sur excel et je voudrais en fait la même chose sur power point mais je n'y parviens pas...

    Pourriez-vous m'aider ?

    Je vous laisse ci-dessous le code de ma macro en EXCEL afin que vous vous rendiez compte de ce que j'aimerais faire à peu près.

    J'espère que c'est bien expliqué sinon n'hésitez pas à me demander d'être plus claire


    Merci par avance pour votre aide
    Louanne.


    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    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
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
     
    Private AltRow As Single
     
    Public Sub Sketches()
    Dim sketchPath As String
    Dim sketchExt As String
    Dim i As Long
    Dim hRel As Single, factor As Single
    Dim strModPrec As String
    Dim strFileName As String
    Dim strDelSketchValue As String
    Dim x As Range
    Dim anyCode As Boolean
    Dim SketchPhoto As Integer
     
    anyCode = False
     
    strSketchPath = "P:\Direction Retail\CROQUIS\"
    strSketchExt = "jpg"
    strDelSketchValue = "N"
     
        AltRow = 100
     
     
        On Error GoTo IsError
        If TypeOf Selection Is Range Then
            For Each x In Selection
                If Not IsEmpty(x.Value) Then
                    If x = "0" Then x = "blank"
                    AltRow = x.Width
                    If x.Value <> sModPrec Then
                        strModPrec = x.Value
                        If Len(RTrim(x.Value)) >= 1 Then
                        SketchPhoto = 0
                            anyCode = True
     
                            strFileName = strSketchPath & RTrim(x.Value) & "." & strSketchExt
     
                            If (strDelSketchValue = "Y") Then
                                x.Value = ""
                            End If
     
                            ActiveSheet.Pictures.Insert(strFileName).Select
                        End If
     
     
     
                        If SketchPhoto > -1 Then
                            x.RowHeight = AltRow + x.Font.Size + 2
                            On Error GoTo IsError
     
                            factor = CSng(AltRow / Selection.ShapeRange.Height)
                            If factor > CSng(x.Width / Selection.ShapeRange.Width) Then
                                factor = CSng(x.Width / Selection.ShapeRange.Width)
                            End If
     
                                With Selection.ShapeRange
                                .LockAspectRatio = msoTrue 'conserver les proportions
                                .Height = x.Height - 4 'hauteur de l'image = hauteur des lignes - 4
                                .Top = x.Top
                                .Left = x.Left
                                End With
     
                        End If
                        On Error GoTo IsError
                    End If
                End If
     
           Next
     
            If anyCode = False Then
                MsgBox "Please select a range that contains Style/StyleFabricColor codes", vbExclamation
            End If
     
     
        End If
        Exit Sub
     
    IsError:
        If Err.Number = 1004 Then
        If SketchPhoto = 1 Then
        SketchPhoto = 0
        strFileName = strSketchPath & Left(RTrim(x.Value), 11) & "." & strSketchExt
        Resume
        Else
        SketchPhoto = -1
        Resume Next
        End If
    Else
        MsgBox Err.Description, vbCritical
    End If
    End Sub

  2. #2
    Expert éminent sénior
    Citation Envoyé par Louanne Voir le message

    Bonjour,

    Votre message est-il toujours d'actualité ?
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter