Add an Attached Caption to a Figure in One Click (Word Macros)

Of late, I am writing a document, and have to put lots of figures with captions in it. As I tried to move the figure to another position, the caption would not follow. That is awful if you got hundreds of figures in your document and often have to edit their positions. There is a well known solution for this problem: http://office.microsoft.com/en-us/word-help/add-captions-in-word-HA102227021.aspx?CTT=1 under "Add a caption to a floating object". In this solution, we try to capsule our figure and its caption in a Textbox, so that if we move the Textbox, the contents (figure and caption) will move together. The solution can do exactly what I want, but it’s too complicated. You have to insert a textbox, and resize it to the right size and arrange it to the right position, and then change its properties and put the Figure in it. I am wondering if I can just make the whole process simpler with help from VB.

I would have liked to introduce the macros that would finish the job at one mouse click. Insert the Figure to your document and place it at the place you want and resize it to the right size. You don’t have to insert a caption by yourself, just keep the figure selected, and then run the macro. You would get a frame that wraps the figure and its caption. Let’s take a look at the code.

At first we should obtain the position and the size of our figure so that we can create the Frame at the right place and in the right size.

Dim clientTop, clientLeft, clientWidth, clientHeigh As Single
 With Selection.InlineShapes(1)
    clientTop = .range.Information(wdVerticalPositionRelativeToPage)
    clientLeft = .range.Information(wdHorizontalPositionRelativeToPage)
    clientWidth = .Width
    clientHeigh = .Height
 End With
Selection.Cut

Then I cut the figure in the clipboard because I don’t need it temporally. In comparison to the solution from Microsoft that taking textbox as container, I prefer to use frame as container. The frame object is simpler and can also do the job. So far as I know, Microsoft Word doesn’t let you create a Frame directly, so I have to insert a textbox at first and convert it to a frame. I have to create the Textbox in an empty place; otherwise it could wrap and then delete some text in your document!

ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
0, _0, 1, 1).Select
Dim ofrm As Word.Frame
Set ofrm = Selection.ShapeRange(1).ConvertToFrame

In the next step, we should bring the Frame to the right place and set it to the desired size. The layout properties can also be set here. With ofrm

    .WidthRule = wdFrameAuto
    .HeightRule = wdFrameAuto
    .HorizontalPosition = clientLeft
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .HorizontalDistanceFromText = 12
    .VerticalPosition = clientTop
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    .VerticalDistanceFromText = 12
    .Borders.OutsideLineStyle = wdLineStyleNone
    .Height = clientHeigh
    .Width = clientWidth
End With

Now I should paste the figure in clipboard to the frame that I had created. Although the frame is selected, I am not in the "edit mode", that means the figure would replace the frame instead of copying itself into the frame. So I have worked it out in a dirty way, I write some text in the frame and then remove it, so that I can enter the "edit mode". I would appreciate if somebody could suggest me a clean way to enter the "edit mode".

'write a dummy to the frame, so that I could enter the "edit mode"
Selection.Font.Color = wdColorWhite
Selection.Font.Size = 8
Selection.TypeText ("Platzhalter")
'Platzhalter wählen und entfernen.
Selection.MoveLeft Unit:=wdCharacter, count:=11, Extend:=wdExtend
Selection.Delete
'Paste the figure in clipboard
Selection.PasteAndFormat (wdFormatOriginalFormatting)

Finally I should select the figure and insert a caption to it.

'Select the figure.
Selection.MoveLeft Unit:=wdCharacter, count:=1, Extend:=wdExtend
'Add caption and put it in the center.
Selection.InsertCaption Label:="Abbildung", TitleAutoText:= _
    "EinfügenBeschriftung1", Title:=" Platzhalter",
Position:=wdCaptionPositionBelow, _
    ExcludeLabel:=0
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

Ok, now you got a figure and a caption in a frame, you can move the frame to wherever you want and just replace the dummy caption with the real caption. For convenience, you can put a shortcut to the macro. I hope this article could help you, please feel free to contact me if there are any questions.

Full code:
Sub AddCaption()
'
' AddCaption Makro
'
'Die Position und Größe des Bildes ermitteln
Dim clientTop, clientLeft, clientWidth, clientHeigh As Single
 With Selection.InlineShapes(1)
    clientTop = .range.Information(wdVerticalPositionRelativeToPage)
    clientLeft = .range.Information(wdHorizontalPositionRelativeToPage)
    clientWidth = .Width
    clientHeigh = .Height
 End With
  Selection.Cut
    ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
0, _0, 1, 1).Select
Selection.ShapeRange.TextFrame.TextRange.Select
  
    'Positionsrahme so angeordnet, damit sie die Größe und die Position
des originale Bilds anpasst.
    Dim ofrm As Word.Frame
    Set ofrm = Selection.ShapeRange(1).ConvertToFrame
    With ofrm
        .WidthRule = wdFrameAuto
        .HeightRule = wdFrameAuto
        .HorizontalPosition = clientLeft
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
        .HorizontalDistanceFromText = 12
        .VerticalPosition = clientTop
        .RelativeVerticalPosition = wdRelativeVerticalPositionPage
        .VerticalDistanceFromText = 12
        .Borders.OutsideLineStyle = wdLineStyleNone
        .Height = clientHeigh
        .Width = clientWidth
    End With
    'Platzhalter eintippen, damit man rein ins das Positionsrahme
können
    Selection.Font.Color = wdColorWhite
    Selection.Font.Size = 8
    Selection.TypeText ("Platzhalter")
    'Platzhalter wählen und entfernen.
    Selection.MoveLeft Unit:=wdCharacter, count:=11, Extend:=wdExtend
    Selection.Delete
    'Bild einfügen und dann wählen, damit die Beschriftung erfolgen
kann.
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.MoveLeft Unit:=wdCharacter, count:=1, Extend:=wdExtend
    'Beschrifftung einfügen und zentrieren.
    Selection.InsertCaption Label:="Abbildung",
TitleAutoText:= _
        "EinfügenBeschriftung1", Title:="
Platzhalter", Position:=wdCaptionPositionBelow, _
        ExcludeLabel:=0
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub