Looking for Suggestions to Macro Inserting Pix into Table 1

[alex20850]

The following macro is to create a table with two columns and then insert a group of graphics files from a location (which will change with each set of instructions) into the second column of the table. The macro moves down into the second row and second column inserts the next picture and so on. After all the pictures are inserted, I go back in and plug in the instructions. AS IT IS NOW, it is still workable for me, but it would be handy if I could control how wide the picture column is. Currently, the picture column takes almost all the space.

Thanks!

================================
Sub QuickSteps()
'
' PixCreateTableforQuickSteps Macro
' Macro recorded 6/9/2009 by Alex Campbell
'
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
.Columns.PreferredWidth = InchesToPoints(3.5)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1

'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
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Next vrtSelectedItem
'If the user presses Cancel...
Else
End If
End With

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

End Sub

 

[fumei]

1. Please use the TGML code tags when posting code.

2. Avoid using Selection.

3. Use objects more.

4. In particular, use an InlineShape object for the images you are inserting. Then you can use it to adjust the size of the InlineShape (the image). You will have to play around with the values you use for resizing. Plus, if your image sizes are different, then...you have a bit more of a problem.

5. While not required, general best practice is to declare all your variables at the start of a procedure.

Sub QuickSteps()
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Dim oTable As Table
Dim oCell As Cell
Dim lngCellNum As Long
Dim oInline As InlineShape

lngCellNum = 2
[COLOR=red]' set table object[/color red]
Set oTable = ActiveDocument.Tables _
      .Add(Range:=Selection.Range, _
      NumRows:=2, NumColumns:=2, _
      DefaultTableBehavior:=wdWord9TableBehavior, _
      AutoFitBehavior:=wdAutoFitFixed)
[COLOR=red]' set cell object to table range cell #2
'  that is, Cells #2[/color red]
Set oCell = oTable.Range.Cells(lngCellNum)

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
   .Filters.Add "Images", "*.gif; *.jpg; *.jpeg"
   .FilterIndex = 2
   If .Show = -1 Then
      For Each vrtSelectedItem In .SelectedItems
[COLOR=red]         '  set InlineShape object - the image[/color red]
         Set oInline = oCell.Range.InlineShapes _
            .AddPicture(FileName:=vrtSelectedItem, _
               LinkToFile:=False, SaveWithDocument:=True)
[COLOR=red]            '  resize image InlineShape object
            '  at 32% of original[/color red]
            With oInline
               .LockAspectRatio = msoTrue
               .ScaleHeight = 32
               .ScaleWidth = 32
            End With
         Set oCell = Nothing
[COLOR=red]         '  error trap against number of rows![/color red]
         If lngCellNum <= oTable.Rows.Count Then
[COLOR=red]            ' if OK, increment counter for
            ' setting cell object[/color red]
            lngCellNum = lngCellNum + 2
            Set oCell = oTable.Range.Cells(lngCellNum)
         Else
            Exit For
         End If
      Next vrtSelectedItem
      'If the user presses Cancel...
   Else
   End If
End With

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

End Sub

The reason there is an error trap against the number of rows is that suppose you select THREE images, but there are only TWO rows. A run-time error would occur as the code would try and action the third image file, but there would be no row to put it in.

Gerry

 

[alex20850]

Thanks for the improvement with the size of the image, but there seems to be a problem with the table rows. The previous macro added a row for each image. The changes to the macro make only two rows even though I chose six image files.

For the six image files chosen, I want to have six rows.

Thanks again.

 

[fumei]

For the six image files chosen, I want to have six rows. "

Then make a table with six rows, or more accurately, the number of files chosen.

You hard-coded the number of rows:

ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= 2,

Plus, you create the table BEFORE you get the filedialog where the users selects the files.

So.....

Display the dialog first.
Get the number of files selected.
THEN make the table.
Make the table row count match the files selected count.

This is logic, not code.


Gerry

 

[alex20850]

The macro did start with two columns and two rows, but as the graphics were added, the table expanded.

 

[alex20850]

The Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
caused the table to expand to fit the number of graphics.

 

[fumei]

The previous macro added a row for each image. That was because you used:

Selection.MoveRight Unit:=wdCell

If the Selection is in the LAST cell of a table that instruction creates a new row.


Gerry

 

[fumei]

Just to follow up, again, it is better to not use Selection...and you do not have to. You did use Selection to create the new row as needed. As I suggested, simply make the created table have the same number of rows as the number of selected files.

fd.SelectedItems has a .Count property, and you can just move the table creating portion of the code to AFTER you get the number of selected files, like this (portion of code only):

With fd
   .Filters.Add "Images", "*.gif; *.jpg; *.jpeg"
   .FilterIndex = 2
   If .Show = -1 Then
      ' set table object
      Set oTable = ActiveDocument.Tables _
            .Add(Range:=Selection.Range, _
            NumRows:=[b].SelectedItems.Count[/b], _
            NumColumns:=2, _
            DefaultTableBehavior:=wdWord9TableBehavior, _
            AutoFitBehavior:=wdAutoFitFixed)
      ' set cell object to table range cell #2
      Set oCell = oTable.Range.Cells(lngCellNum)

      For Each vrtSelectedItem In .SelectedItems
      '  etc. etc.

The table is created with the number of rows equal to the .Count of .SelectedItems.

Gerry

 

[alex20850]

I think I added the last code correctly, but I got what appears to be a table within a table.

Did you get that when you ran the macro?

I appreciate your help.

 

[fumei]

I am guessing you did not MOVE the table creating instruction, you added it AGAIN in the With fd instructions. Otherwise I do not see how it would create two tables.

So.....

Display the dialog first.
Get the number of files selected.
THEN make the table.
Make the table row count match the files selected count.

This is logic, not code.

Gerry