Using VBA to change Picture

Question

I am trying to use VBA to automate the Change Picture function when you right click a Shape in Excel/Word/Powerpoint.

However, I am not able to find any reference, c

Answer 1

I tried to imitate the original function of 'Change Picture' with VBA in PowerPoinT(PPT)

The code below tries to recover following properties of the original picture: - .Left, .Top, .Width, .Height - zOrder - Shape Name - HyperLink/ Action Settings - Animation Effects

Option Explicit

Sub ChangePicture()

    Dim sld As Slide
    Dim pic As Shape, shp As Shape
    Dim x As Single, y As Single, w As Single, h As Single
    Dim PrevName As String
    Dim z As Long
    Dim actions As ActionSettings
    Dim HasAnim As Boolean
    Dim PictureFile As String
    Dim i As Long

    On Error GoTo ErrExit:
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then MsgBox "Select a picture first": Exit Sub
    Set pic = ActiveWindow.Selection.ShapeRange(1)
    On Error GoTo 0

    'Open FileDialog
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Picture File", "*.emf;*.jpg;*.png;*.gif;*.bmp"
        .InitialFileName = ActivePresentation.Path & "\"
        If .Show Then PictureFile = .SelectedItems(1) Else Exit Sub
    End With

    'save some properties of the original picture
    x = pic.Left
    y = pic.Top
    w = pic.Width
    h = pic.Height
    PrevName = pic.Name
    z = pic.ZOrderPosition
    Set actions = pic.ActionSettings    'Hyperlink and action settings
    Set sld = pic.Parent
    If Not sld.TimeLine.MainSequence.FindFirstAnimationFor(pic) Is Nothing Then
        pic.PickupAnimation 'animation effect <- only supported in ver 2010 above
        HasAnim = True
    End If

    'insert new picture on the slide
    Set shp = sld.Shapes.AddPicture(PictureFile, False, True, x, y)

    'recover original property
    With shp
        .Name = "Copied_ " & PrevName

        .LockAspectRatio = False
        .Width = w
        .Height = h

        If HasAnim Then .ApplyAnimation 'recover animation effects

        'recover shape order
        .ZOrder msoSendToBack
        While .ZOrderPosition < z
            .ZOrder msoBringForward
        Wend

        'recover actions
        For i = 1 To actions.Count
            .ActionSettings(i).action = actions(i).action
            .ActionSettings(i).Run = actions(i).Run
            .ActionSettings(i).Hyperlink.Address = actions(i).Hyperlink.Address
            .ActionSettings(i).Hyperlink.SubAddress = actions(i).Hyperlink.SubAddress
        Next i

    End With

    'delete the old one
    pic.Delete
    shp.Name = Mid(shp.Name, 8)  'recover name

ErrExit:
    Set shp = Nothing
    Set pic = Nothing
    Set sld = Nothing

End Sub

How to use: I suggest you to add this macro into the Quick Access Toolbar list. (Goto Option or Right-click on the Ribbon menu)) First, select a Picture on the slide which you want to change. Then, if the FileDialog window opens, choose a new picture. It's done. By using this method, you can bypass the 'Bing Search and One-Drive Window' in ver 2016 when you want to change a picture.

In the code, there might(or should) be some mistakes or something missing. I'd appreciate it if somebody or any moderator correct those errors in the code. But mostly, I found that it works fine. Also, I admit that there are still more properties of the original shape to recover - like the line property of the shape, transparency, pictureformat and so on. I think this can be a beginning for people who want to duplicate those TOO MANY properties of a shape. I hope this is helpful to somebody.