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
