# Insert a picture using a macro



## emalsamac (Dec 17, 2010)

Hi there, I am trying to create a macro that will insert a picture from a folder, but prompt the user to type the file name of the picture, which selects which picture to use. All pictures in the folder are named 3 letters.bmp (eg abc.bmp)

I used this code to open the folder which opens the folder but doesn't insert the picture.

Sub InsertSig()
'
' InsertSig Macro
'
'
Dim FileToOpen As String
' Set the default directory.
' Note: Substitute any existing directory.
Options.DefaultFilePath(Path:=wdDocumentsPath) = "L:\My Folder\Signature"
With Dialogs(wdDialogFileOpen)
On Error Resume Next
If .Display <> 0 Then
FileToOpen = WordBasic.FilenameInfo(.Name, 1)
Else
MsgBox "No file selected"
End If
End With
End Sub

The code below inserts the the picture named AGB.bmp from the folder. However there are many pictures in the folders, so I need a prompt for the user to select which one.

Sub InsertSig()
'
' InsertSig Macro
'
'
Selection.InlineShapes.AddPicture FileName:=("L:\My Folder\Signature\AGB.bmp")

End Sub

I am not an expert with code and would not know how to merge these codes together, or how to get it to prompt the user with a file/open prompt and then insert it as a picture into a word doc.

Can anyone help?

Thanks


----------



## macropod (Apr 11, 2008)

Hi emalsamac,

Try something along the lines of:

```
Sub InsertSig()
' Set the default directory.
' Note: Substitute any existing directory.
Options.DefaultFilePath(Path:=wdPicturesPath) = "L:\My Folder\Signature"
  With Dialogs(wdDialogInsertPicture)
    On Error Resume Next
    SendKeys "%{t}{w}{w}{TAB}"
    If .Display <> 0 Then
      .Execute
    Else
      MsgBox "No file selected"
    End If
End With
End Sub
```
This code uses the Insert|Pictures dialogue box and limits the files initially offered to bmp graphics files. By default, the first such file is selected, though the user can change the selection - or they can cancel out. If you have a fairly reliable way of determining a default file for the user (eg from the user initials stored in Word), these could be programmatically entered into the filename field on the dialogue box.


----------



## OleRasmusen (Dec 21, 2010)

Here try this code below - have a textbox on your user form called 'TBpath.Text' & a Command B called ''CmdBrowse" - u have to mess with it a bit - I just copy & paste from some code I use.



Private Sub CmdBrowse_Click()
Dim strPath As String
strPath = TBpath.Text
TBpath.Text = GetFolder(strPath) 'Set path to files
'populate list of file names
Dim FileSpec As String
Dim FileArray() As Variant
FileSpec = TBpath.Text & "\*.xls"
If OptXLS.Value Then FileSpec = TBpath.Text & "\*.xls"
If OptXLSX.Value Then FileSpec = TBpath.Text & "\*.xlsx"

Call GetFileList(FileSpec, FileArray)
With LBxlsFile
.Clear
For i = 1 To UBound(FileArray)
.AddItem FileArray(i)
Next i
End With
Erase FileArray
End Sub


Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Function GetFileList(FileSpec As String, FileArray() As Variant) As Variant 
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function


----------

