A
alex20850
I found most of the macro online and made some changes, but I'm not sure of
all of the functions being done.
The macro lets you select a group of graphic files and then inserts them
into a Word table with one graphic per row.
I would appreciate comments on what the different parts of the macro do.
Sub AddPix()
Dim fd As FileDialog
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1,
NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitContent
With Selection.Tables(1)
.Columns.PreferredWidth = InchesToPoints(4.5)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
Selection.Rows.HeadingFormat = wdToggle
Selection.Rows.AllowBreakAcrossPages = False
End With
Selection.Tables(1).Columns(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).Columns(1).PreferredWidth = InchesToPoints(0.75)
Selection.Tables(1).Columns(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).Columns(1).PreferredWidth = InchesToPoints(5.75)
Selection.Tables(1).Select
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
'Creates Header Row
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
'Creates Header Row
'Selection.Tables(1).AutoFitBehavior (wdAutoFitFixed)
'Selection.Tables(1).AutoFitBehavior (wdAutoFitFixed)
'Declare a variable as a FileDialog object.
'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.
'Adds blank lines before each picture
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
'Add blank lines before each picture
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
all of the functions being done.
The macro lets you select a group of graphic files and then inserts them
into a Word table with one graphic per row.
I would appreciate comments on what the different parts of the macro do.
Sub AddPix()
Dim fd As FileDialog
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1,
NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitContent
With Selection.Tables(1)
.Columns.PreferredWidth = InchesToPoints(4.5)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
Selection.Rows.HeadingFormat = wdToggle
Selection.Rows.AllowBreakAcrossPages = False
End With
Selection.Tables(1).Columns(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).Columns(1).PreferredWidth = InchesToPoints(0.75)
Selection.Tables(1).Columns(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).Columns(1).PreferredWidth = InchesToPoints(5.75)
Selection.Tables(1).Select
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
'Creates Header Row
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
'Creates Header Row
'Selection.Tables(1).AutoFitBehavior (wdAutoFitFixed)
'Selection.Tables(1).AutoFitBehavior (wdAutoFitFixed)
'Declare a variable as a FileDialog object.
'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.
'Adds blank lines before each picture
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
'Add blank lines before each picture
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