A
alexander.craens
I am trying the following macro but i would like to get a row added
below each inserted picture where the description woud be inserted.
How do I change the macro to do that and whould it work if the table
has 2 columns
Sub InsertAllPicsInFolder()
'
' InsertAllPicsInFolder Macro
' Macro created 15/12/2008 by Alex CRAENS
'
Dim tbl As Word.Table
Dim fso, f, fi
Dim szPicPath As String, lCellCounter As Long
szPicPath = "C:\Documents and Settings\alex.craens\Desktop\ERSH-HQ
\P&V - Photography. & Video"
lCellCounter = 1
Set tbl = ActiveDocument.Tables(1)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(szPicPath)
For Each fi In f.Files
Select Case Right(fi.Name, 3)
Case "bmp", "jpg", "gif"
If lCellCounter > tbl.Range.Cells.Count _
Then tbl.Rows.Add
ActiveDocument.InlineShapes.AddPicture _
FileName:=szPicPath & "\" & fi.Name, _
Range:=tbl.Range.Cells(lCellCounter).Range
lCellCounter = lCellCounter + 1
Case Else
End Select
Next fi
End Sub
below each inserted picture where the description woud be inserted.
How do I change the macro to do that and whould it work if the table
has 2 columns
Sub InsertAllPicsInFolder()
'
' InsertAllPicsInFolder Macro
' Macro created 15/12/2008 by Alex CRAENS
'
Dim tbl As Word.Table
Dim fso, f, fi
Dim szPicPath As String, lCellCounter As Long
szPicPath = "C:\Documents and Settings\alex.craens\Desktop\ERSH-HQ
\P&V - Photography. & Video"
lCellCounter = 1
Set tbl = ActiveDocument.Tables(1)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(szPicPath)
For Each fi In f.Files
Select Case Right(fi.Name, 3)
Case "bmp", "jpg", "gif"
If lCellCounter > tbl.Range.Cells.Count _
Then tbl.Rows.Add
ActiveDocument.InlineShapes.AddPicture _
FileName:=szPicPath & "\" & fi.Name, _
Range:=tbl.Range.Cells(lCellCounter).Range
lCellCounter = lCellCounter + 1
Case Else
End Select
Next fi
End Sub