Code to insert pictures into individual cells down the rows

[LisaMc73]

I am new to this macro thing and have played around with various codes but none do exactly what I need it to, and I have no idea what all the code means so I can't change much!
I tried to add a screen shot but that wouldn't work so I will try to explain...
I have a table with 15+ columns and 120+ rows
The first row has headings
Species, Detail, Treatment. %, Day one, Day two, day three etc....
first 4 columns have set information then I need to add the photos
on the row day one.... I need up to 120+ photos to be inserted in each cell going downwards.... starting from the cell the cursor is in (as sometimes it may be photos from a different time slot, so might add 40 photos then and other 50 etc...)
So where ever I put my cursor the photos will add the photos down the rows... The following code it the closest I have got to it however it keeps putting it in the first column and it adds a weird table in the first cell.... also adds a caption which I did work out how to delete and I need the photos to come out bigger....
Sub InsertMultipleImagesFixed()
Dim fd As FileDialog
Dim oTable As Table
Dim iRow As Integer
Dim iCol As Integer
Dim oCell As Range
Dim i As Long
Dim sNoDoc As String
Dim picName As String
Dim scaleFactor As Long
Dim max_height As Single
'define resize constraints
max_height = 275

'add a 1 row 2 column table to take the images
Set oTable = Selection.Tables.Add(Selection.Range, 1, 1)
'+++++++++++++++++++++++++++++++++++++++++++++
'oTable.AutoFitBehavior (wdAutoFitFixed)
oTable.Rows.Height = CentimetersToPoints(4)
oTable.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'++++++++++++++++++++++++++++++++++++++++++++++

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png; *.wmf"
.FilterIndex = 2
If .Show = -1 Then

For i = 1 To .SelectedItems.Count

iCol = 1
iRow = i
'get filename
picName = Right(.SelectedItems(i), Len(.SelectedItems(i)) - InStrRev(.SelectedItems(i), ""))
'remove extension from filename ****
picName = Left(picName, InStrRev(picName, ".") - 1)

'select cell
Set oCell = ActiveDocument.Tables(1).Cell(iRow, iCol).Range

'insert image
oCell.InlineShapes.AddPicture FileName:= _
.SelectedItems(i), LinkToFile:=False, _
SaveWithDocument:=True, Range:=oCell

'resize image
If oCell.InlineShapes(1).Height > max_height Then
scale_factor = oCell.InlineShapes(1).ScaleHeight * (max_height / oCell.InlineShapes(1).Height)
oCell.InlineShapes(1).ScaleHeight = 2
oCell.InlineShapes(1).ScaleWidth = 2
End If

'center content
oCell.ParagraphFormat.Alignment = wdAlignParagraphCenter

'insert caption below image
oCell.InlineShapes(1).Range.InsertCaption Label:="Figure", TitleAutoText:="", _
Title:=": "
If i < .SelectedItems.Count And i Mod 2 = 0 Then 'add another row, more to go
oTable.Rows.Add
End If
Next i
End If
End With

Set fd = Nothing
End SubI really have no idea what all that means but it is the closed I have come!!!!
Is there anyone out there that would be able to make a code to help me!! if you know what I am talking about it certainly doesn't have to be anything like the code above... just showing sort of what kinda works
This is for a scientific report and it is taking me forever!!!!
Would REALLY appreciate ANY help!!
Thank you so much
Looking forward to hearing from you
*** Lisa

[gmayor]

Based on your code and your comments, I think the following may be closer to what you have in mind. It will fill down the column from where the cell where the cursor is located. It will restrict the height of the images to 4 cm. and will label the images with the image filename without extension. If there are insufficient rows another row will be added for each additional image.

Sub InsertMultipleImagesFixed()
Dim fd As FileDialog
Dim oTable As Table
Dim iRow As Integer
Dim iCol As Integer
Dim oCell As Range
Dim oShape As InlineShape
Dim i As Long
Dim picName As String
Dim max_height As Single
If Selection.Information(wdWithInTable) = False Then GoTo lbl_Exit
Selection.Collapse 1
Set oTable = Selection.Tables(1)
iRow = Selection.Information(wdEndOfRangeRowNumber)
iCol = Selection.Information(wdEndOfRangeColumnNumber)
oTable.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
max_height = CentimetersToPoints(4)

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Select image files and click OK"
.AllowMultiSelect = True
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png; *.wmf"
.FilterIndex = 2
If .Show = -1 Then
For i = 1 To .SelectedItems.Count
If oTable.Rows.Count < iRow Then oTable.Rows.Add
Set oCell = ActiveDocument.Tables(1).Cell(iRow, iCol).Range
oCell.End = oCell.End - 1
picName = .SelectedItems(i)
picName = Left(picName, InStrRev(picName, ".") - 1)
picName = Mid(picName, InStrRev(picName, Chr(92)) + 1)
Set oShape = oCell.InlineShapes.AddPicture( _
FileName:=.SelectedItems(i), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Range:=oCell)
'resize image
If oShape.Height > max_height Then
oShape.LockAspectRatio = msoTrue
oShape.Height = max_height
End If
'center content
oCell.ParagraphFormat.Alignment = wdAlignParagraphCenter
'insert caption below image
oShape.Range.InsertCaption Label:="Figure", TitleAutoText:="", _
Title:=": " & picName
iRow = iRow + 1
DoEvents
Next i
End If
End With
lbl_Exit:
Set oShape = Nothing
Set fd = Nothing
Set oTable = Nothing
Set oCell = Nothing
Exit Sub
End Sub

[LisaMc73]

GMayor you are an absolute gem. Problem solved
You will be a genius in my book for all time
THANK YOU THANK YOU THANK YOU