Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 02-11-2014, 05:46 AM
Navis Navis is offline Macro to add captions to pictures inside word document Windows XP Macro to add captions to pictures inside word document Office 2010 64bit
Novice
Macro to add captions to pictures inside word document
 
Join Date: Feb 2014
Posts: 1
Navis is on a distinguished road
Post Macro to add captions to pictures inside word document

Hi,

I am very new to VB and Macros. I have around 100 images in my document and i need to assign format style "Captions" to all my images and insert Figure Captions below images as "Figure 1: <<Insert Titele Here>>".

I recorded macro and my macro look like below and unable to loop this for entire document.

Sub Macro1()
'
' Macro1 Macro
'
'
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^g"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False


.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Style = ActiveDocument.Styles("Caption")
Selection.InsertCaption Label:="Figure", TitleAutoText:="InsertCaption1", _
Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
End Sub
Reply With Quote
  #2  
Old 02-12-2014, 05:26 AM
macropod's Avatar
macropod macropod is offline Macro to add captions to pictures inside word document Windows 7 32bit Macro to add captions to pictures inside word document Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,453
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

There are two kinds of image formats one can encounter with a Word document: in-line and floating. With the in-line format, it's quite easy to insert a caption after the image and know where it will be in relation to that image. With floating shapes, however, the only way of ensuring the captions align with the images is to insert textboxes that can be positioned near the images.

In either case, the problem then becomes one of ensuring the captions and images stay together on the same page. The best way of doing this is to insert both the image and its caption into a Word table. For floating shapes, that means changing their format to in-line, but that's OK since the table can be made to float over the text in much the same way.

Compared to what's involved in the above, finding the in-line shapes and floating shapes is quite easy; instead of using Find, you loop through the InlineShape and Shape collections, respectively. For example, the following macro embeds all Shapes & InlineShapes in a document in tables with a row for Captions.
Code:
Sub AddImageCaptionTables()
Dim iShp As InlineShape, Rng As Range, Tbl As Table
Dim i As Long, PicWdth As Single, PicHght As Single, VPos As Single
Dim HPos As Single, VRel As Long, HRel As Long, BShp As Boolean
With ActiveDocument
  For i = 1 To .InlineShapes.Count
    If .InlineShapes(i).Range.Information(wdWithInTable) = False Then
      PicWdth = .InlineShapes(i).Width
      Set Rng = .InlineShapes(i).Range
      With Rng
        If .Characters.Last.Next.Text = vbCr Then .Characters.Last.Next.Text = vbNullString
        PicWdth = .InlineShapes(1).Width
        PicHght = .InlineShapes(1).Height
        .InlineShapes(1).Range.Cut
      End With
      BShp = False: VRel = 0: HRel = 0: VPos = 0: HPos = 0
      Call MakeImageTable(Rng, PicWdth, PicHght, BShp, VRel, HRel, VPos, HPos)
    End If
  Next
  While .Shapes.Count > 0
    BShp = True
    With .Shapes(1)
      PicWdth = .Width
      PicHght = .Height
      VRel = .RelativeVerticalPosition
      HRel = .RelativeHorizontalPosition
      VPos = .Top
      HPos = .Left
      Set iShp = .ConvertToInlineShape
    End With
    With iShp
      Set Rng = .Range
      .Range.Cut
    End With
    Call MakeImageTable(Rng, PicWdth, PicHght, BShp, VRel, HRel, VPos, HPos)
  Wend
End With
End Sub
 
Sub MakeImageTable(Rng As Range, PicWdth As Single, PicHght As Single, BShp As Boolean, _
  VRel As Long, HRel As Long, VPos As Single, HPos As Single)
Dim Tbl As Table, sngScl As Single, iShp As InlineShape
'Create & format the table
Set Tbl = Rng.Tables.Add(Range:=Rng, Numrows:=2, NumColumns:=1)
With Tbl
  .Borders.Enable = False
  .Columns.Width = PicWdth
  .TopPadding = 0
  .BottomPadding = 0
  .LeftPadding = 0
  .RightPadding = 0
  .Spacing = 0
  .Rows(1).HeightRule = wdRowHeightExactly
  .Rows(1).Height = PicHght
  With .Rows
    .LeftIndent = 0
    If BShp = True Then
      .WrapAroundText = True
      .HorizontalPosition = HPos
      .RelativeHorizontalPosition = HRel
      .VerticalPosition = VPos
      .RelativeVerticalPosition = VRel
      .AllowOverlap = False
    End If
  End With
  With .Cell(1, 1).Range
    With .ParagraphFormat
      .SpaceBefore = 0
      .SpaceAfter = 0
      .LeftIndent = 0
      .RightIndent = 0
      .FirstLineIndent = 0
      .KeepWithNext = True
    End With
    .Paste
    ' Resize the inserted InlineShape
    Set iShp = .InlineShapes(1)
    With iShp
      .Width = PicWdth
      .Height = PicHght
    End With
  End With
  With .Cell(2, 1).Range
    .Style = "Caption"
    .End = .End - 1
    .InsertAfter vbCr
    .InsertCaption Label:="Figure", TitleAutoText:=" ", Title:="", _
      Position:=wdCaptionPositionBelow, ExcludeLabel:=0
    .Paragraphs.First.Range.Characters.Last.Text = vbNullString
    .Paragraphs.First.Range.Characters.Last.Text = vbNullString
  End With
End With
End Sub
Note that, due to the extra space taken up by the caption row, all except for the first of the document's pictures are liable to shift position.

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #3  
Old 04-22-2014, 08:07 AM
Benble Benble is offline Macro to add captions to pictures inside word document Windows 7 32bit Macro to add captions to pictures inside word document Office 2010 32bit
Novice
 
Join Date: Apr 2014
Posts: 12
Benble is on a distinguished road
Default Regarding the topic Macro to add captions to pictures inside word document

Hi Paul

I wonder if you could help me with creating a caption in another way. We have this tool that creates a RTF document which I have converted to *.doc by running a macro and using the ActiveDocument.SaveAs2 function. In the document I have some fields codes with the tag "xe" and description of the diagram. Is it possible to use a similar macro in this topic to replace the "xe" tag and use the caption with the descriptiont. It is OK if the picture and caption is not on the same page, but it would be "nice to have". The "xe" tag will always follow the picture. I ran you code AddImageCaptionTables just to see how it looks but then I do not have any text to the caption. /Regards Benble
Reply With Quote
  #4  
Old 04-22-2014, 04:57 PM
macropod's Avatar
macropod macropod is offline Macro to add captions to pictures inside word document Windows 7 32bit Macro to add captions to pictures inside word document Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,453
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

Try running the following macro after the AddImageCaptionTables macro (you can call this one from that one):
Code:
Sub AddCaptionText()
Dim Tbl As Table, RngCell As Range, RngRef As Range, StrTxt As String
For Each Tbl In ActiveDocument.Tables
  Set RngCell = Tbl.Range.Cells(Tbl.Range.Cells.Count).Range
  With RngCell
    .End = .End - 1
    .Collapse wdCollapseEnd
    If .Style = "Caption" Then
      Set RngRef = .Paragraphs.Last.Next.Next.Range
      With RngRef
        .End = .End - 1
        If .Fields.Count = 1 Then
          If .Fields(1).Type = wdFieldIndexEntry Then
            StrTxt = Trim(Replace(Replace(.Fields(1).Code.Text, "XE ", _
              vbNullString, , , vbTextCompare), Chr(34), ""))
            With RngCell
              .Text = ": " & StrTxt
              .Collapse wdCollapseEnd
              .FormattedText = RngRef.FormattedText
            End With
            .Paragraphs.First.Range.Delete
          End If
        End If
      End With
    End If
  End With
Next
End Sub
Note: With this code, your Index references are moved into the tables so they stay together.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #5  
Old 04-22-2014, 10:32 PM
Benble Benble is offline Macro to add captions to pictures inside word document Windows 7 32bit Macro to add captions to pictures inside word document Office 2010 32bit
Novice
 
Join Date: Apr 2014
Posts: 12
Benble is on a distinguished road
Default

Hi Paul!

Many thanks for the code and a prompt reply, works like a charm. I wonder if it is simple to change this AddCaptionText or the AddImageCaptionTables function to have the text above the image (in row 1 instead of having the caption the after the image).
/Kind regards
Benble
Reply With Quote
  #6  
Old 04-22-2014, 10:45 PM
Benble Benble is offline Macro to add captions to pictures inside word document Windows 7 32bit Macro to add captions to pictures inside word document Office 2010 32bit
Novice
 
Join Date: Apr 2014
Posts: 12
Benble is on a distinguished road
Default Regarding the topic Macro to add captions to pictures inside word document

Hi Paul!

What is the code to expand the table so the text in the table is not written in several lines (unless it is so large the it does not fit on one row on the whole page).

See attached pic's . The first one show the result now after the functions AddImageCaptionTables and AddCaptionText and the second is the look and feel I would like to have.

pic1.jpg

pic2.jpg

(You should now that I think this really good site to get help from. It helps me a lot!)

Kind Regards
Benble
Reply With Quote
  #7  
Old 04-22-2014, 11:09 PM
macropod's Avatar
macropod macropod is offline Macro to add captions to pictures inside word document Windows 7 32bit Macro to add captions to pictures inside word document Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,453
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

Quote:
Originally Posted by Benble View Post
I wonder if it is simple to change this AddCaptionText or the AddImageCaptionTables function to have the text above the image (in row 1 instead of having the caption the after the image).
To have the caption row appear above the image, instead of below, edit the MakeImageTable macro. Change the: Rows(1) references to Rows(2); Cell(1, 1) references to Cell(2, 1); and Cell(2, 1) references to Cell(1, 1). Similarly, with the AddCaptionText macro, change Tbl.Range.Cells.Count to 1.

Quote:
Originally Posted by Benble View Post
What is the code to expand the table so the text in the table is not written in several lines (unless it is so large the it does not fit on one row on the whole page).
As coded, the table widths are the same as the picture widths. The intention behind that is to allow for text wrapping around the pictures and their captions. The code line that gets the picture width is:
PicWdth = .InlineShapes(i).Width
and the code line that applies it is:
.Columns.Width = PicWdth
Without the second of the above lines, the table widths will fill the margins. A compromise might be to set a minimum width for PicWdth, via either of:
If PicWdth < CentimetersToPoints(8.9) Then PicWdth = CentimetersToPoints(8.9)
or:
If PicWdth < InchesToPoints(3.5) Then PicWdth = InchesToPoints(3.5)
immediately after the PicWdth = .InlineShapes(i).Width lines. You could, of course, change the units indicated to something else.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #8  
Old 04-23-2014, 01:29 AM
Benble Benble is offline Macro to add captions to pictures inside word document Windows 7 32bit Macro to add captions to pictures inside word document Office 2010 32bit
Novice
 
Join Date: Apr 2014
Posts: 12
Benble is on a distinguished road
Default

Hi Paul

Thanks for the help. Then the text will be below the image. I have used you suggestion to make a compromise by set a minimum width for PicWdth.
/Regards Benble
Reply With Quote
  #9  
Old 03-31-2016, 08:14 PM
Jazz43 Jazz43 is offline Macro to add captions to pictures inside word document Windows 7 64bit Macro to add captions to pictures inside word document Office 2010 64bit
Advanced Beginner
 
Join Date: Oct 2009
Posts: 54
Jazz43 is on a distinguished road
Default

Hi Paul,

I'm having a similar problem with adding captions to images in Word. Your first macro works well for the first time, however, if I tried to run it again when I added some new images to the document, it would just do nothing at all. Can you check on this?

Last edited by macropod; 03-31-2016 at 08:17 PM. Reason: Deleted unnecessary quote of entire post replied to
Reply With Quote
  #10  
Old 03-31-2016, 08:24 PM
macropod's Avatar
macropod macropod is offline Macro to add captions to pictures inside word document Windows 7 64bit Macro to add captions to pictures inside word document Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,453
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

The macro is not intended to be used every time you insert a new image; it's a one-off conversion process. For code you could use when inserting new pics, see: https://www.msofficeforums.com/word/...html#post78488
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #11  
Old 05-03-2016, 10:41 AM
Jazz43 Jazz43 is offline Macro to add captions to pictures inside word document Windows 7 64bit Macro to add captions to pictures inside word document Office 2010 64bit
Advanced Beginner
 
Join Date: Oct 2009
Posts: 54
Jazz43 is on a distinguished road
Default

Quote:
Originally Posted by macropod View Post
The macro is not intended to be used every time you insert a new image; it's a one-off conversion process. For code you could use when inserting new pics, see: https://www.msofficeforums.com/word/...html#post78488
I've tried this before. It somehow skips some of the pictures (even though they are all in the same format) and always ends in a bug notice. Besides, sometimes I run it and the caption always misses the 'F' at the beginning of 'Figure'. I don't really understand it? Could you check to see what the issue is?
Reply With Quote
  #12  
Old 05-03-2016, 02:44 PM
macropod's Avatar
macropod macropod is offline Macro to add captions to pictures inside word document Windows 7 64bit Macro to add captions to pictures inside word document Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,453
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

The problem you're having with pictures being skipped and the code error-ing out is most likely due to there being no content between the pictures (i.e. they're next to each other or there's only a single paragraph break between them). The code really wasn't designed for that. You need to have at least an empty paragraph between the pics. I've fixed the code to address the loss of the 'F' at the beginning of 'Figure'.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #13  
Old 10-10-2018, 04:15 AM
scoope scoope is offline Macro to add captions to pictures inside word document Windows 7 32bit Macro to add captions to pictures inside word document Office 2013
Novice
 
Join Date: Oct 2018
Posts: 2
scoope is on a distinguished road
Default

Apologies for resurrecting an old thread, but I have a similar issue and I haven't been able to find a work around yet.

I have a word doc that includes hundreds of pictures (jpg) inserted in cells of a table, with two columns per row. In each cell there is either one single picture or some text, never both.

I have been asked to go through this document and add a simple figure reference to each picture. I'm looking for help with a macro that can read the entire thing and add 'Fig. 1' etc, under each picture in 9pt Arial.

I'm a complete novice with macros and have only used those that other people have written; I have no idea if this is even possible, but help would be appreciated.

Thank you .
Reply With Quote
  #14  
Old 10-10-2018, 04:59 AM
gmayor's Avatar
gmayor gmayor is offline Macro to add captions to pictures inside word document Windows 10 Macro to add captions to pictures inside word document Office 2016
Expert
 
Join Date: Aug 2014
Posts: 3,219
gmayor is a glorious beacon of lightgmayor is a glorious beacon of lightgmayor is a glorious beacon of lightgmayor is a glorious beacon of lightgmayor is a glorious beacon of lightgmayor is a glorious beacon of light
Default

Maybe something like


Code:
Sub Macro1()
Dim oCell As Cell
Dim oShape As InlineShape
    With ActiveDocument.Styles("Caption").Font
        .Name = "Arial"
        .Size = 9
        .Color = wdColorAutomatic
    End With

    For Each oCell In Selection.Tables(1).Range.Cells
        If oCell.Range.InlineShapes.Count = 1 Then
            Set oShape = oCell.Range.InlineShapes(1)
            oShape.Range.InsertCaption _
                    Label:="Figure", _
                    TitleAutoText:="InsertCaption1", _
                    Title:="", _
                    Position:=wdCaptionPositionBelow, _
                    ExcludeLabel:=0
        End If
        DoEvents
    Next oCell
lbl_Exit:
    Set oShape = Nothing
    Set oCell = Nothing
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #15  
Old 10-10-2018, 05:08 AM
scoope scoope is offline Macro to add captions to pictures inside word document Windows 7 32bit Macro to add captions to pictures inside word document Office 2013
Novice
 
Join Date: Oct 2018
Posts: 2
scoope is on a distinguished road
Default

Thank you! That's worked a treat!
Reply With Quote
Reply

Tags
automatic figure caption

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro to add captions to pictures inside word document Help formatting Pictures inside a Text Box in Word 2013 jstumbo87 Word 2 01-29-2014 12:07 PM
Macro to add captions to pictures inside word document Macro to read word document harishankar.selvaraju Excel Programming 1 06-14-2012 03:48 AM
Macro to add captions to pictures inside word document VBA to insert captions without appending to existing captions Marrick13 Word VBA 16 02-19-2012 06:06 AM
Where we can find a Word document (docx file) that contains professional work inside? Jamal NUMAN Word 0 06-26-2011 09:57 AM
Captions and Figures Inside a Frame...RIDICULOUS MS hasn't developed a solution!!! stlsmiln Word 2 02-23-2010 02:15 AM

Other Forums: Access Forums - Senior Forums

All times are GMT -7. The time now is 08:28 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2020, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2020 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft