Microsoft Office Forums - View Single Post - [Solved] TOC links to images in document?

macropod · 11-06-2011, 05:50 AM

Hi Splint,

FWIW, here's a macro, based on one I developed for https://www.msofficeforums.com/drawi...ument-all.html.

This version inserts all the jpg files in a folder into a Word document, with the pic names in the 'Heading 1' Style. If you:
• add a TOC field to the document, then run the macro; or
• run the macro, then add a TOC field to the document,
you'll have entries pointing to each pic by name. You may want to modify the document's Heading 1 Style to have no numbering and to start on a new page. As coded, all images are scaled to 6in wide.

Code:

Sub AddPics()
Application.ScreenUpdating = False
Dim strFolder As String, strPic As String, Rng As Range, iShp As InlineShape
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strPic = Dir(strFolder & "\*.jpg", vbNormal)
With ActiveDocument
  While strPic <> ""
    Set Rng = .Range.Characters.Last
    With Rng
      .InsertAfter Split(strPic, ".")(0) & vbCr & vbCr
      .Paragraphs.First.Style = "Heading 1"
    End With
    Set iShp = .InlineShapes.AddPicture(FileName:=strFolder & "\" & strPic, _
      LinkToFile:=False, SaveWithDocument:=True, Range:=Rng.Characters.Last.Previous)
    With iShp
      .LockAspectRatio = True
      .Width = InchesToPoints(6)
    End With
    strPic = Dir()
  Wend
  .Fields.Update
End With
Set Rng = Nothing: Set iShp = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function