Insert specific picture and add specific Text to it

Syasthe · #1 11-01-2017, 06:32 AM

Hello

I need a macro, which opens a folder, where I have my pictures. Then, depending on which picture I choose, it should insert a certain text. The pictures will be inserted in a table cell and the text should appear in the next table cell.

For better understanding, I need it to insert warning signs in manuals and the description of the warning signs. So the pictures and descriptions are always the same.

To open the Folder, I thought, something like this could work:

Code:

    Dim sPath As String
    Dim sPicPath As String
    Dim lRes As Long
    
    sPicPath = "C:\Temp"
    sPath = Options.DefaultFilePath(path:=wdPicturesPath)
    Options.DefaultFilePath(path:=wdPicturesPath) = sPicPath
    lRes = Application.Dialogs(wdDialogInsertPicture).Show
    Options.DefaultFilePath(path:=wdPicturesPath) = sPath

I found this code and it works, but I don't know how to continue. I'm new to VBA.

Thank you for your time

gmayor · #2 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.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Mail Merge Rules - IF, OR Function to Insert Specific text	larry11	Mail Merge	2	06-25-2017 06:15 AM
Insert Text with specific Font Size	Nick70	PowerPoint	1	08-10-2016 09:56 AM
How to insert text at specific location as bold	PRA007	Word VBA	7	01-05-2016 10:12 PM
Macro to Insert text into the beginning on specific paragraphs unless the paragraph is blank	caboy	Word VBA	2	04-01-2015 07:00 AM
how to create menu shortcut to insert specific picture	msworddave	Word	1	05-08-2013 02:00 AM