#1
|
|||
|
|||
VBA to insert captions without appending to existing captions
I’m attempting to create a utility that inserts captions for shapes, inline shapes and tables (separately). The code is the attached Sub InsertCaptionImages1 module does just that for inline shapes except for two things:
1. It can count the inline shapes in all stories but insert captions only for those in the main body 2. If the document already has captions for inlineshapes (or other objects that can have captions), it adds additional captions. The idea of inserting captions separately for the three objects is that one might want to use different labels for each, such as “figure” for shapes and inline shapes; and “table” for tables; “equation” for something else; or a custom label as Word allows. That any standard label can be applied to any object type, and that any caption label can be user-defined, leads me to believe the only option is to somehow tie the field code SEQ to the object type. (I’ve been using the attached “Sub ShowSelectionType” module to have Word tell me the type of object I’ve selected.) I realize that captions and their text, if any, have no connection to the object for which they were created other than their initial placement, so I thought an approach for determining whether captions exist was to loop through the specific shape collection and detect whether each has a SEQ field, then ignore those that do and insert the caption for those that don’t. That might work in theory, but with my very limited VBA, I am not having any success in executing this idea, as evidenced by my stabs at it in Sub InsertCaptionImages2 (beginning about halfway down the module). I found some code that deletes captions and all of the text associated with them, which I tried to adapt for the unique insertion code, but didn’t succeed (that code is included in the attachment as “Sub DeleteCaptionNumText”). There is also the fact that when you manually insert a caption for a shape, Word creates a small text box and writes the caption number and label in it. For inline shapes, the caption label and text are written in the body. I don’t know if this affects anything here, but I thought I’d mention it. So is it possible to insert captions separately for shapes, inline shapes and tables without appending to existing captions? If not, I will just abandon the effort and make a note to run the Sub InsertCaptionImages1 only once…. |
#2
|
||||
|
||||
Hi Marrick,
Word captions are inserted using the Caption Style. So, in general terms, you should look to see if the first non-empty paragraph before/after the inlineshape (depending on wheter the captions should be above/below) is in that Style. If so, you can probably safely not insert a caption for that inlineshape. Edit: Here's some code I posted in another forum. It finds the first Inlineshape without a Caption, then exits after scrolling to the Shape concerned. Code:
Sub FindUncaptionedShape() Dim oCap As CaptionLabel, iShp As InlineShape, TmpRng As Range, TmpStr As String For Each oCap In CaptionLabels TmpStr = TmpStr & CaptionLabels(oCap) & " " Next With ActiveDocument For Each iShp In .InlineShapes Set TmpRng = iShp.Range.Words.Last With TmpRng Do While Len(.Text) = 1 .MoveEnd wdWord, 1 .MoveStart wdWord, 1 Loop If InStr(TmpStr, .Text) = 0 Then iShp.Select Selection.GoTo What:=wdGoToObject Selection.MoveRight wdCharacter, 1 Exit Sub End If End With Next End With End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Hi Paul,
Thanks for this - it works almost as I need it to. I added "iShp.Range.InsertCaption Label:="Figure", TitleAutoText:="", Title:= "", Position:=wdCaptionPositionBelow, ExcludeLabel:=0" after the "iShp.Select" line to actually insert the caption. However, as you stated, the code stops after finding the first empty paragraph before or after a shape; I need it to continue throughout the document to insert captions for all inline shapes without captions. One could run the code again but once it no longer finds any shapes without captions it just loops endlessly. I tried modifying your code to insert captions for all uncaptioned shapes without success. Preferably it should loop through all stories in the event a shape or table is in a header, footer, or some other story. |
#4
|
||||
|
||||
Hi Marrick,
Quote:
Code:
If InStr(TmpStr, .Text) = 0 Then iShp.Select Selection.GoTo What:=wdGoToObject Selection.MoveRight wdCharacter, 1 Exit Sub End If Code:
If InStr(TmpStr, .Text) = 0 Then iShp.Range.InsertCaption Label:="Figure", TitleAutoText:="", _ Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0 End If
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Thanks, but I don't think it's that simple. It creates a caption for the first uncaptioned object and then gets hung up in the
.MoveEnd wdWord, 1 .MoveStart wdWord, 1 Loop area. Then I created a new doc with three inlineshapes without creating any captions. The code just hung up and didn't create any captions. The test document is attached. |
#6
|
||||
|
||||
Hi Marrick,
Oops - I tested with your attachment, saw that it worked and didn't test further. Try: Code:
Sub ApplyCaptions() Application.ScreenUpdating = True Dim RngStry As Range, iShp As InlineShape, TmpRng As Range For Each RngStry In ActiveDocument.StoryRanges For Each iShp In RngStry.InlineShapes Set TmpRng = iShp.Range.Paragraphs.First.Range With TmpRng If .Style <> "Caption" Then If .Paragraphs.Last.Next.Style <> "Caption" Then iShp.Range.InsertCaption Label:="Figure", TitleAutoText:="", _ Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0 End If End If End With Next Next Set TmpRng = Nothing Application.ScreenUpdating = False End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
Works great - thanks, Paul! I see you also included code to search all stories. Just what I wanted, except that when it gets to the footer (and presumably the header, if it contained an inline shape), it errors with 4605 ("This method or property is not available because the object refers to a header or footer").
Actually, I just realized that Word doesn't allow one to create captions for shapes in headers, footers, footnotes or endnotes, so I guess there's no benefit to having the code search all stories. But there are 17 stories, right? Perhaps it should have an error trap/message instead? I'm sure I can adapt this code to do the same for tables, but shapes are different. The Intellisense for "For Each Shp In RngStry." is "shaperange", not "shapes," and "shaperange" doesn't work (when the variable is declared as a shape or shaperange). Can you advise what i need to do to make it work for shapes as well? |
#8
|
||||
|
||||
Hi Marrick,
Yes, as per the macro to list bookmarks, there are presently 17 storyranges. I imagine you couldn't even add an inlineshape to some of them. Adding 'On Error Resume Next' anywhere before the line that throws the error should take care of any errors. With shape objects, locating captions is quite problematic, as there's no necessary relationship between where they're anchored and where any caption should appear.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
Hi Paul,
Gee, I thought you'd have some magic to handle the shapes. Anyway, thanks again for all your help! |
#10
|
||||
|
||||
Hi Marrick,
Oh, I can handle shapes alright, it's just that relating them to captions is far from being reliable. Just consider what happens if you have a shape overlying another shape, an in-line shape or a table. Do both get captioned? And what about shapes sent behind text. Then there's the question of shapes in multi-column documents where the shape spans more than one column - where should the caption go? A reliable way of ensuring shapes and their captions always remain together is to convert the shapes to inline (grouped beforehand, if necessary), then put them into a table, with the corresponding caption. The table's wrap format can then be set to 'around', which allows it to be positioned more or less as flexibly as a shape. Of course, this should be done up-front, or at least before any captions are applied to the shapes.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
I was only joshing - I figured you had examined shapes from all angles (as it were), but recognized that those scenarios made captioning like trying to capture lightning in a bottle. A few years back I came up with the idea of putting a table in a text box to get the best advantages of both shapes and tables (it allows you to place more than one table in the same plane while also allowing you to tabularize text in the shape). It worked great as long as captions weren't needed. They could be inserted manually, of course, but I don't think automating captions would be very reliable.
For now I will just manually insert captions for shapes and can use your code to insert captions for uncaptioned inline shapes. When I adapted the inline code to work on tables, it doesn't recognize existing table captions and appends new ones. But I have a delete-caption-by-label macro that I can use to remove all table captions, and then create new ones by the table label. Unless, of course, you want to take a whack at seeing why the code adapted for table captions (Sub ApplyTableCaptions) in the attached doesn't see existing captions? |
#12
|
||||
|
||||
Hi Marrick,
Assuming we're back to working with only the main story: Code:
Sub ApplyCaptions() Application.ScreenUpdating = True Dim RngStry As Range, iShp As InlineShape, oTbl As Table, TmpRng As Range With ActiveDocument For Each iShp In .InlineShapes Set TmpRng = iShp.Range.Paragraphs.First.Range With TmpRng If .Style <> "Caption" Then If .Paragraphs.Last.Next.Style <> "Caption" Then iShp.Range.InsertCaption Label:="Figure", TitleAutoText:="", _ Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0 End If End If End With Next For Each oTbl In .Tables Set TmpRng = oTbl.Range.Paragraphs.Last.Range With TmpRng If .Paragraphs.Last.Next.Style <> "Caption" Then oTbl.Range.InsertCaption Label:="Figure", TitleAutoText:="", _ Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0 End If End With Next End With Set TmpRng = Nothing Application.ScreenUpdating = False End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#13
|
|||
|
|||
Main story yes, but I just tested this and it seems to apply captions to every other shape and table. I've attached the test file with 3 inline shapes and 4 tables. The code captions the first and third shapes and the first and third tables (it ignores the 5th table).
|
#14
|
||||
|
||||
Hi Marrick,
It might help if you didn't have empty paragraphs in the Caption Style! Ordinarily, one wouldn't expect to see that Style in use without a caption. If the implication I'm supposed to draw is that someone might have deleted the caption without deleting the paragraph, then we'd have to build in some extra code to validate every 'caption' paragraph's contents.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#15
|
|||
|
|||
That is a very real possibility, isn't it? I was deleting and inserting to test the code, but under normal circumstances, I would remove captions by selecting and deleting them manually (I also ran the delete macro in that test file). Most users wouldn't concern themselves with empty paragraphs and would just remove captions by the handiest method. Only if they had many to remove would they look for an easier solution, such as a macro, and if one were available, they might need to delete some they added afterwards, and that could create more empty paragraphs.
So a more "professional" approach would be for the code to consider empty paragraphs and insert captions for all inline shapes and tables regardless of such paragraphs. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Move existing table captions | bcarlier | Word Tables | 17 | 05-10-2014 02:36 PM |
Captions/Styles | NWoffice | Word | 5 | 10-06-2011 10:26 AM |
creating tables for row of figures and captions | gib65 | Word | 2 | 08-12-2011 01:25 PM |
Captions (tables and figures) | mcjohn | Word | 1 | 02-11-2010 10:36 PM |
Captions | dwilliams | Word | 0 | 10-07-2009 08:30 AM |