MACRO PPT Insérer une image placée dans un fichier en fonction d'un texte sélect

Fermé
Louanne - Modifié le 25 oct. 2019 à 10:05
jordane45 Messages postés 38206 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 14 juin 2024 - 25 oct. 2019 à 10:01
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.


 
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
A voir également:

1 réponse

jordane45 Messages postés 38206 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 14 juin 2024 4 677
23 oct. 2019 à 23:45
Bonjour,

Pour t'aider à coder dans powerpoint, il faut regarder la doc qui va avec.
Ce ne sont pas les mêmes instructions entre Excel et powerpoint (ou word ou outlook.... )

Bref, ceci devrait te mettre sur la voie
https://docs.microsoft.com/fr-fr/office/vba/api/excel.shapes.addpicture

Puis un exemple
Sub insert()
    Dim oPic As Shape
    Set oPic = ActivePresentation.Slides(1).Shapes.AddPicture("c:\tonimage.bmp", True, True, 100, 100, 250, 250)
End Sub


NB: Pour poster ton code, il faut préciser le LANGAGE dans les balises de code.
Explications disponibles ici :
https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code
Cela permet d'avoir la coloration syntaxique et l'indentation.
Merci.
0
Merci Jordane !

J'ai en effet ce lien que j'avais déjà regardé mais je n'arrivais pas en tirer quelque chose...

Super le code fonctionne parfaitement. J'ai changé quelques petites choses afin de l'automatiser (voir ci-dessous). Mais je. bloque sur mon "FIleName" je voudrais faire quelque chose du style

FileName = LE TEXTE SELECTIONNE

Mais je n'arrive pas à le désigner en VBA malgré mes recherches. Il ne s'agit pas de TextRange ni de Selection.. je bloque. Saurais-tu comment désigner le texte sélectionné en VBA ? Ensuite je pense que ça fonctionnera très bien.

PS: le texte sélectionné en question sur la slide est, tu l'auras compris "084125" écrit sur la slide.


Merci pour ton aide
Louanne.

Sub insert()
    Dim oPic As Shape
    Lien = "P:\Direction Retail\CROQUIS\"
    FileName = "084125"
    Extension = ".jpg"

    strFileName = Lien & FileName & Extension 
    Set oPic = ActivePresentation.Slides(1).Shapes.AddPicture(strFileName, True, True, 100, 100, 250, 250)
End Sub
0
jordane45 Messages postés 38206 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 14 juin 2024 4 677 > Louanne
25 oct. 2019 à 10:01
Pour avoir le texte sélectionné le code c'est :
Dim sTxt As String
sTxt = ActiveWindow.Selection.TextRange.Text


0