Microsoft Office Forums - View Single Post - [Solved] VBA to automatically insert photo number underneath all the images

gmaxey · 12-12-2024, 04:40 AM

While Graham's add-in is a logical step forward; if you just want to fix what you already have, you could try one of the following procedures:

Code:

Sub FixExisting()
Dim oTbl As Table
Dim oCell As Cell
Dim oRng As Range
Dim lngIndex As Long
  Set oTbl = Selection.Tables(1)
  lngIndex = 1
  For Each oCell In oTbl.Range.Cells
    If oCell.Range.InlineShapes.Count = 1 Then
      Set oRng = oCell.Range.InlineShapes(1).Range
      oRng.Collapse wdCollapseEnd
      oRng.InsertAfter "Picture " & lngIndex
      lngIndex = lngIndex + 1
    End If
  Next
lbl_Exit:
  Exit Sub
End Sub
Sub FixExistingII()
Dim oTbl As Table
Dim oCell As Cell
Dim oRng As Range
Dim lngIndex As Long
  Set oTbl = Selection.Tables(1)
  lngIndex = 1
  For Each oCell In oTbl.Range.Cells
    If oCell.Range.InlineShapes.Count = 1 Then
      Set oRng = oCell.Range.InlineShapes(1).Range
      oRng.Collapse wdCollapseEnd
      oRng.Move wdCharacter, 1
      oRng.InsertAfter "Picture " & lngIndex & " "
      lngIndex = lngIndex + 1
    End If
  Next
lbl_Exit:
  Exit Sub
End Sub