#1
|
|||
|
|||
MACRO in infinite loop when it encounters user defined figure label
I created a MACRO in VBA that looks for words in all capitals and their definitions if the user defined them and places all these words in a new document. It works for the most part but I now have a problem that if I use a heading style to create a new figure label to allow for chapter numbering in appendices then the macro gets into an infinite loop. It does a good job up to the first figure in the appendix and then decides to start back at the beginning of the document. If I select the Figure label and toggle the field codes, then the macro will work fine.
Attached is my test file. It should have the macro included. It is called "ListAcronyms" Is there a way to get it to either skip over the specialized field codes or to toggle all the specialized field codes to be displayed at the beginning of the macro and then hide them at the end? Thanks in Advance. Notes on special formatting: Heading 1-6 - typical chapter numbering 1.1.1 .... Heading 7 - Appendix A, B, .... Heading 8 A.1, B.1, ...... Caption - Figure label should use Heading 1 as the chapter number so you get Figure 1.1, Figure 2.4, etc. Same for Table label. I created two new labels: Figure_Apx and Table_Apx that use Heading 7 as the chapter number so I get Figure_Apx A.1, Table_Apx A.4, etc. However I then deleted the "_Apx" and then highlighted the text to create an Autotext entry. That way when I insert AutoText FigureAppendix it will insert Figure A.1 without the extraneous "_Apx" text. I followed http://www.shaunakelly.com/word/numb...ppendixes.html when creating these styles. |
#2
|
||||
|
||||
Without seeing your code, which you haven't posted and isn't in your attached document, it's impossible to give any specific advice.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Code attached showing macro
Sorry, I thought the code would be in the document. I am attaching the normal.dotm which is where my macro resides.
I am also copy & pasting the macro here in case the file doesn't work. The place in the macro where it gets stuck in an infinite loop is on the ".Execute" statement in the "With Selection.Find" lines when it get to Figure in the Figure_Apx label. The ".Execute" causes the Macro to jump back to the beginning of the document for some reason. (I hope this statement makes sense). Code:
Sub ListAcronyms() ' ' ListAcronyms Macro ' Macro created 6/9/2009 by vk830c ' 'The macro looks through the document for anything it thinks might be an acronym (All CAPS). 'It then looks for the definition. It assumes the following format: Test Work Description (TWD) 'Once the macro is finished going through the document, it creates a new document, 'adds the acronyms there, and then sorts them all. If an Acronym isn't defined on the first 'go around, it should still be in the list without a definition. 'Note this macro will find ALL capitalized words whether they are words or acronyms. 'If you are looking through a document that has tracking changes on, I would recommend accepting 'all the changes before running the macro as sometimes the comments/changes have a hidden character that 'causes the macro to stop. 'I would also add the word ZDEBUG at the very end of the file, then run the macro 'In this manner you can verify that the macro made it through the entire document 'before giving you output. If it doesn't make through the end of the document the most likely 'cause is a hidden character and I haven't figured out a work around for that. 'I would recommend deleting the current acronym list in a document before running this macro 'if you want to verify that all the acronyms are in the document. 'Note - this macro will not find embedded acronyms in pictures. 'DEBUG Notes - add the word ZDEBUG in the document to find out where the macro is crashing. Select DebugFound variable. 'Then select Debug--> Add Watch and have it Break when value changes. Also open View--> Immediate window to see the 'debug statements. This will allow the Macro to stop whenever it finds the words DEBUG. Dim strAcronym As String Dim strTest As String Dim strDefine As String Dim strOutput As String Dim AcronymDefined As Boolean Dim DebugFound As Boolean Dim newDoc As Document Dim length As Integer Dim i As Integer Application.ScreenUpdating = False Selection.HomeKey unit:=wdStory ActiveWindow.View.ShowHiddenText = False 'Loop to find all acronyms Do 'Search for acronyms using wildcards Selection.Find.ClearFormatting With Selection.Find .ClearFormatting ' .Text = "<[A-Z]@[A-Z,1-9]@[A-Z,1-9]>" .Text = "<[A-Z]@[A-Z,1-9]>" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = True .MatchWildcards = True .MatchWholeWord = True .Execute End With 'Only process if something found If Selection.Find.Found Then 'Make a string from the selection, add it to the output string strAcronym = " " & Selection.Text & " " length = Len(strAcronym) - 2 AcronymDefined = False If InStr(strAcronym, "DEBUG") <> 0 Then Debug.Print "the length of the strOutput = " & Len(strOutput) DebugFound = True End If 'Look for definition Selection.MoveRight unit:=wdCharacter, Extend:=wdExtend strTest = Selection.Text If Right(strTest, 1) = ")" Then ' acronym is in parenthesis AcronymDefined = True ' find beginning "(" Selection.MoveLeft unit:=wdCharacter, Count:=length + 2, Extend:=wdExtend strTest = Selection.Text 'debug statement Selection.MoveLeft unit:=wdWord, Count:=length, Extend:=wdExtend strTest = Selection.Text strTest = Mid(strTest, 1, Len(strTest) - 1) End If strDefine = "" If Not AcronymDefined Then strTest = "" End If If InStr(strOutput, strAcronym) = 0 Then Debug.Print "Adding"; strAcronym strOutput = strOutput & strAcronym _ & vbTab & strTest & vbCr End If End If ' now move ahead of acronym If AcronymDefined Then Selection.MoveRight unit:=wdWord, Count:=length Debug.Print "Acronym was defined, move forward one word" End If If Not AcronymDefined Then Selection.MoveRight unit:=wdCharacter, Count:=1 Debug.Print "Acronym was NOT defined, move forward one character" End If If length = 0 Then 'might be in an infinite loop 'skip ahead a word Selection.MoveRight unit:=wdWord, Count:=5 End If DebugFound = False Loop Until Not Selection.Find.Found 'Create new document and change active document Set newDoc = Documents.Add 'Insert the text Selection.TypeText Text:=strOutput 'Sort it newDoc.Content.Sort SortOrder:=wdSortOrderAscending Application.ScreenUpdating = True Selection.HomeKey unit:=wdStory End Sub Last edited by macropod; 01-13-2016 at 02:07 AM. Reason: Added code tags & formatting |
#4
|
||||
|
||||
Files in the docx format cannot contain macros.
I suggest you take a look at: http://windowssecrets.com/forums/sho...=1#post1033883 Amongst other things, I don't expect that code to get hung up on fields. Besides which, the code there is much more efficient than what you're now using. PS: When posting code, please use the code tags, indicated by the # button on the posting menu.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
FileSystemObject Compile Error: User-Defined Type Not Defined | gsrikanth | Excel Programming | 2 | 03-28-2022 06:32 AM |
Macro to replace text and track changes based on user-defined rules | Thefirstfish` | Word VBA | 13 | 01-09-2016 07:14 AM |
Outlook 2013 - caught in an infinite loop on startup | borderfox | Outlook | 0 | 07-26-2015 01:40 PM |
User-defined Type not Defined VBA Issue | OTPM | Project | 3 | 01-02-2014 01:47 PM |
'Infinite Loop' error with Infopath 2010 | Debbie25 | Misc | 2 | 05-18-2011 08:38 AM |