Macro Inserts *Last* One Chosen Rather First of Set 1

[alex20850]

The purpose of the following macro is to insert screen captures into the right cell of a table move down to the next row and then over the right cell again. It allows you to select a set of image files such as file01, file02, file03, file04, file05. Instead, it inserts the last one selected - in this example file05 - and THEN file01, file02, file03, file04.

Sub AddPix2()
    Dim fd As FileDialog
   
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
        2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitContent
   
     Selection.MoveRight Unit:=wdCell
 
    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
               
                'Does this create extra row? No
                Selection.MoveRight Unit:=wdCell
                Selection.MoveRight Unit:=wdCell
           
            Next vrtSelectedItem
        'If the user presses Cancel...
        Else
        End If
    End With
    Selection.HomeKey Unit:=wdStory
    Selection.Rows.HeadingFormat = wdToggle
    Selection.Rows.HeadingFormat = wdToggle
    'Set the object variable to Nothing.
    Set fd = Nothing

End Sub

 

[SkipVought]

Hi,

VBA questions belong in forum707. Please repost.


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[macropod]

Hi Alex,

This is a quirk of how Windows works when you select & copy multiple items - the last one selected gets copied first, then the rest. It's not something peculiar to your code. Instead of using a For Each loop, you'll need to use a count-based loop (eg For i = 1 to .SelectedItems.Count). Even then I'm not sure whether can start at 1, or if you'll need to start at 2 and finish off with .SelectedItems(1).


Cheers
[MS MVP - Word]