Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Need Help Adapting This Macro for Purpose

Status
Not open for further replies.

alex20850

Programmer
Mar 28, 2003
83
US
I have NO experience writing macros.
I would like to start with a table with the first column empty and the images in the second column.

I want to end up with the first column empty and each image is on a different row in the second column.

The purpose of this to pull all the screenshots into a table where the first column will be used for instructions explaining the images in the second column.

I set the default location of Clipart Pictures with File Locations. It would be very useful if the user could choose the file location as part of the macro.

I created a table with one row and two columns.

I put the cursor in the second column, chose Insert, Picture, From File.

I highlighted the first picture and clicked on Insert.

Then I pressed tab twice.
The first is to create a new row.
The second was to move to the second column.

I would like the macro to move through the selected pictures in the folder.

Here is the macro I want to adapt
==========================================================================
Use the FileDialog rather can the Word's Dialogs. The FileDialog collection
allows multiple selection.
From the VBA Help file's example for FileIndex Property I modified the code
to insert multiple graphics into the document.
Sub AddMuliplePictures()
'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Add a filter that includes GIF and JPEG images and make it the
second item in the list.
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg"

'Sets the initial file filter to number 2.
.FilterIndex = 2

'Use the Show method to display the File Picker dialog box and
return the user's action.
'If the user presses the action button...
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of each
selected item.

Selection.InlineShapes.AddPicture FileName:= _
vrtSelectedItem _
, LinkToFile:=False, SaveWithDocument:=True
Next vrtSelectedItem
'If the user presses Cancel...
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub

--
Harold Kless, MCSD
Support Professional
Microsoft Technical Support for Business Applications
haro...@microsoft.com
 
1. Please use the TGML code tags when posting code.

2. Use a Table object, like this:
Code:
Dim oTable As Table
Dim j As Long

Set oTable = Selection.Tables(1)

.....other stuff....

  For Each vrtSelectedItem In .SelectedItems
    j = oTable.Range.Cells.Count
    oTable.Range.Cells(j).Range.InlineShapes.AddPicture _
        FileName:= vrtSelectedItem, _
                LinkToFile:=False, SaveWithDocument:=True
    oTable.Rows.Add
  Next vrtSelectedItem

...other stuff...
The above assumes the Selection is in the table you wish to action. This does NOT have to be the case. You could action it for any table, anywhere.

Note 1: it is much better to not use Selection at all.
Note 2: there will be an empty row at the end, so you will have to delete it. I did not include that code.

It will however, add a new row for each item and put the image file there. It does NOT do any reaizing, or processsing, of the images inserted.

faq219-2884

Gerry
My paintings and sculpture
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top