Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 02-14-2012, 02:31 PM
Marrick13 Marrick13 is offline VBA to insert captions without appending to existing captions Windows XP VBA to insert captions without appending to existing captions Office 2010 32bit
Competent Performer
VBA to insert captions without appending to existing captions
 
Join Date: Jun 2006
Posts: 102
Marrick13 will become famous soon enough
Default 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….
Attached Files
File Type: doc Caption Test.doc (102.5 KB, 30 views)
Reply With Quote
  #2  
Old 02-15-2012, 10:52 PM
macropod's Avatar
macropod macropod is online now VBA to insert captions without appending to existing captions Windows 7 64bit VBA to insert captions without appending to existing captions Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #3  
Old 02-16-2012, 07:12 AM
Marrick13 Marrick13 is offline VBA to insert captions without appending to existing captions Windows XP VBA to insert captions without appending to existing captions Office 2010 32bit
Competent Performer
VBA to insert captions without appending to existing captions
 
Join Date: Jun 2006
Posts: 102
Marrick13 will become famous soon enough
Default

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.
Reply With Quote
  #4  
Old 02-16-2012, 02:47 PM
macropod's Avatar
macropod macropod is online now VBA to insert captions without appending to existing captions Windows 7 64bit VBA to insert captions without appending to existing captions Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Marrick,
Quote:
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.
That's a fairly simple change, really. Replace:
Code:
      If InStr(TmpStr, .Text) = 0 Then
        iShp.Select
        Selection.GoTo What:=wdGoToObject
        Selection.MoveRight wdCharacter, 1
        Exit Sub
      End If
with:
Code:
      If InStr(TmpStr, .Text) = 0 Then
        iShp.Range.InsertCaption Label:="Figure", TitleAutoText:="", _
           Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
      End If
All you need to do now is to add the code for looping through the other story ranges.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #5  
Old 02-16-2012, 04:40 PM
Marrick13 Marrick13 is offline VBA to insert captions without appending to existing captions Windows XP VBA to insert captions without appending to existing captions Office 2010 32bit
Competent Performer
VBA to insert captions without appending to existing captions
 
Join Date: Jun 2006
Posts: 102
Marrick13 will become famous soon enough
Default

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.
Attached Files
File Type: docx Caption Test (2).docx (22.1 KB, 16 views)
Reply With Quote
  #6  
Old 02-16-2012, 05:02 PM
macropod's Avatar
macropod macropod is online now VBA to insert captions without appending to existing captions Windows 7 64bit VBA to insert captions without appending to existing captions Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
As hinted at in my first post, this macro simply looks for the Caption Style - either attached to the inlineshape's own paragraph, or in the following one.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #7  
Old 02-16-2012, 05:38 PM
Marrick13 Marrick13 is offline VBA to insert captions without appending to existing captions Windows XP VBA to insert captions without appending to existing captions Office 2010 32bit
Competent Performer
VBA to insert captions without appending to existing captions
 
Join Date: Jun 2006
Posts: 102
Marrick13 will become famous soon enough
Default

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?
Reply With Quote
  #8  
Old 02-16-2012, 05:47 PM
macropod's Avatar
macropod macropod is online now VBA to insert captions without appending to existing captions Windows 7 64bit VBA to insert captions without appending to existing captions Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #9  
Old 02-16-2012, 06:16 PM
Marrick13 Marrick13 is offline VBA to insert captions without appending to existing captions Windows XP VBA to insert captions without appending to existing captions Office 2010 32bit
Competent Performer
VBA to insert captions without appending to existing captions
 
Join Date: Jun 2006
Posts: 102
Marrick13 will become famous soon enough
Default

Hi Paul,

Gee, I thought you'd have some magic to handle the shapes. Anyway, thanks again for all your help!
Reply With Quote
  #10  
Old 02-16-2012, 10:22 PM
macropod's Avatar
macropod macropod is online now VBA to insert captions without appending to existing captions Windows 7 64bit VBA to insert captions without appending to existing captions Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #11  
Old 02-17-2012, 05:42 AM
Marrick13 Marrick13 is offline VBA to insert captions without appending to existing captions Windows XP VBA to insert captions without appending to existing captions Office 2010 32bit
Competent Performer
VBA to insert captions without appending to existing captions
 
Join Date: Jun 2006
Posts: 102
Marrick13 will become famous soon enough
Default

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?
Attached Files
File Type: docx Caption Test (2).docx (23.2 KB, 15 views)
Reply With Quote
  #12  
Old 02-17-2012, 07:07 PM
macropod's Avatar
macropod macropod is online now VBA to insert captions without appending to existing captions Windows 7 64bit VBA to insert captions without appending to existing captions Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #13  
Old 02-17-2012, 09:50 PM
Marrick13 Marrick13 is offline VBA to insert captions without appending to existing captions Windows XP VBA to insert captions without appending to existing captions Office 2010 32bit
Competent Performer
VBA to insert captions without appending to existing captions
 
Join Date: Jun 2006
Posts: 102
Marrick13 will become famous soon enough
Default

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).
Attached Files
File Type: docx Caption Test (2).docx (23.0 KB, 15 views)
Reply With Quote
  #14  
Old 02-18-2012, 12:31 AM
macropod's Avatar
macropod macropod is online now VBA to insert captions without appending to existing captions Windows 7 64bit VBA to insert captions without appending to existing captions Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #15  
Old 02-18-2012, 08:05 AM
Marrick13 Marrick13 is offline VBA to insert captions without appending to existing captions Windows XP VBA to insert captions without appending to existing captions Office 2010 32bit
Competent Performer
VBA to insert captions without appending to existing captions
 
Join Date: Jun 2006
Posts: 102
Marrick13 will become famous soon enough
Default

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.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
VBA to insert captions without appending to existing captions 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
VBA to insert captions without appending to existing captions creating tables for row of figures and captions gib65 Word 2 08-12-2011 01:25 PM
VBA to insert captions without appending to existing captions Captions (tables and figures) mcjohn Word 1 02-11-2010 10:36 PM
Captions dwilliams Word 0 10-07-2009 08:30 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 06:20 AM.


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