Changing a Picture in Microsoft Visio

Visio doesn't give you a built in way to change the picture that you've added to a diagram to another picture. But with some VBA code, you can perform the task.

First, you will need to add the code below. Press Alt+F11 on the keyboard to open the Visual Basic Editor. Click Insert > Module from the menu. Paste the code below into the module. Save your drawing as a Visio Macro-Enabled Drawing (with a .vsdm extension).

Then to change a picture to another picture, select it. Then press Alt+F8 to open the macros dialog. Select ChangePicture from the dialog and click Run. A dialog will open asking you for a file. Select the file and click OK. The picture will change without losing things such as connections to the picture.

Most of the code is just to open the dialog to ask for the filename. The main  task is to call the shape's ChangePicture method.

Option Explicit

Private Declare PtrSafe Function GetOpenFileName _
    Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" ( _
    pOpenfilename As OPENFILENAME) As Long

Private Declare PtrSafe Function CommDlgExtendedError _
    Lib "comdlg32.dll" () As Long

Private Type OPENFILENAME
    lStructSize         As Long
    hwndOwner           As LongPtr
    hInstance           As LongPtr
    lpstrFilter         As String
    lpstrCustomFilter   As String
    nMaxCustFilter      As Long
    nFilterIndex        As Long
    lpstrFile           As String
    nMaxFile            As Long
    lpstrFileTitle      As String
    nMaxFileTitle       As Long
    lpstrInitialDir     As String
    lpstrTitle          As String
    flags               As Long
    nFileOffset         As Integer
    nFileExtension      As Integer
    lpstrDefExt         As String
    lCustData           As LongPtr
    lpfnHook            As LongPtr
    lpTemplateName      As String
    '#if (_WIN32_WINNT >= 0x0500)
    pvReserved          As LongPtr
    dwReserved          As Long
    FlagsEx             As Long
    '#endif // (_WIN32_WINNT >= 0x0500)
End Type

Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000&
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOLONGNAMES = &H40000          '  force no long names for 4.x modules
Private Const OFN_EXPLORER = &H80000             '  new look commdlg
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_LONGNAMES = &H200000           '  force long names for 3.x modules

Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0

Private Const CDERR_DIALOGFAILURE = &HFFFF&

Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_STRUCTSIZE = &H1
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_REGISTERMSGFAIL = &HC

Private Function GetFileName() As String
    Dim lngResult As Long
    Const MAX_BUFFER As Long = 250

    Dim OFN As OPENFILENAME

    With OFN
        .lpstrFilter = "All Files (*.*)" & vbNullChar & "*.*" & vbNullChar
        .nFilterIndex = 1
        .lpstrFile = Space$(MAX_BUFFER - 1) & vbNullChar
        .nMaxFile = Len(.lpstrFile)
        .lpstrFileTitle = Space$(MAX_BUFFER - 1) & vbNullChar
        .nMaxFileTitle = Len(.lpstrFileTitle)
        .lpstrInitialDir = "C:\"
        .flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
        .lStructSize = LenB(OFN)
    End With

    lngResult = GetOpenFileName(OFN)

    If lngResult <> 0 Then
        GetFileName = Left$(OFN.lpstrFile, InStr(1, OFN.lpstrFile, vbNullChar) - 1)
    Else
        GetFileName = vbNullString
    End If
End Function

Public Sub ChangePicture()
    Dim strFileName As String
    Dim shp As Shape
    
    ' Ensure a shape is selected
    If Application.ActiveWindow.Selection.Count = 0 Then
        MsgBox "Please select a shape first."
        Exit Sub
    End If
    
    strFileName = GetFileName()
    If Len(strFileName) > 0 Then
        Set shp = Application.ActiveWindow.Selection.PrimaryItem
        Call shp.ChangePicture(strFileName)
    End If
End Sub