Microsoft Office Forums - View Single Post - Insert specific picture and add specific Text to it

gmayor · 11-02-2017, 02:08 AM

Frankly I wouldn't personally do it this way. A userform to select the required images from a list would be preferable, however:

The following will open C:\Temp if it exists

Code:

Function BrowseForFile(Optional strTitle As String) As String
'Graham Mayor - http://www.gmayor.com - Last updated - 02 Nov 2017
'strTitle is the title of the dialog box
'Set bExcel value to True to filter the dialog to show Excel files
'The default is to show Word files
Dim fDialog As FileDialog
Dim sFolder As String

    If FolderExists("C:\Temp\") Then
        sFolder = "C:\Temp\"
    Else
        sFolder = vbNullString
    End If
    On Error GoTo err_Handler
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .Title = strTitle
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Graphics Files", "*.jpg,*.png,*.tif"
        .InitialView = msoFileDialogViewList
        .InitialFileName = sFolder
        If .Show <> -1 Then GoTo err_Handler:
        BrowseForFile = fDialog.SelectedItems.Item(1)
    End With
lbl_Exit:
    Exit Function
err_Handler:
    BrowseForFile = vbNullString
    Resume lbl_Exit
End Function

You can call it from your macro e.g.

Code:

Sub Macro1()
Dim iShape As InlineShape
Dim strPath As String
Dim oRng As Range
Dim oCell As Cell
    strPath = BrowseForFile("Select a picture")
    If Not Selection.Information(wdWithInTable) Then
        MsgBox "Select the cell to insert the image and run the macro again"
        GoTo lbl_Exit
    End If
    Set oCell = Selection.Cells(1)
    Set oRng = oCell.Range
    oRng.End = oRng.End - 1
    Set iShape = oRng.InlineShapes.AddPicture(strPath)
    Set oCell = oCell.Next
    Set oRng = oCell.Range
    oRng.End = oRng.End - 1
    Select Case strPath
        Case "C:\Temp\picname1.jpg"
            oRng.Text = "This is the text for picname1.jpg"
        Case "C:\Temp\picname2.jpg"
            oRng.Text = "This is the text for picname1.jpg"
        Case "C:\Temp\picname3.jpg"
            oRng.Text = "This is the text for picname1.jpg"
        Case Else
            oRng.Text = "This is the text for any other picture selected"
    End Select
lbl_Exit:
    Set oCell = Nothing
    Set oRng = Nothing
    Set iShape = Nothing
    Exit Sub
End Sub

Change the texts and filenames as appropriate.