#1
|
|||
|
|||
Find code is ignoring MatchCase flag and range end being incorrectly set
The below code is supposed to search the attached WorkingDoc.docx based on the attached strCheckDoc.docx. Words in the left column of strCheckDoc are found and highlighted, and contents of the right column for a given row are added as a comment to the highlighted word. The search is supposed to be performed in a range that is defined according to the headers that bound respective sections of WorkingDoc.
There are currently two issues that I haven't been able to track down resolutions for: 1) MatchCase = False is set, but the search is still acting case sensitive. For example, fullapplicationword is not being found based on the search for Fullapplicationword. 2) The GetDocRange function does not appear to be correctly setting the end of aRng. For example, backgroundword is found in all sections beginning with and following the BACKGROUND section instead of just in the range between "BACKGROUND" and "SUMMARY," summaryword is found in all sections beginning with and following the SUMMARY section instead of just in the range between "SUMMARY" and "DRAWINGS," etc. Does anyone see what I could be missing to result in the above errors? Code:
Sub Highlight(ByRef strUser As String) Dim strCheckDoc As String, docRef As Document, docCurrent As Document, trkChg As Boolean Dim wrdRef As String, wrdPara As Paragraph, strKeyword As String, strRule As String Dim cmtRuleComment As Comment, tbl1 As Table, tbl2 As Table, tbl3 As Table, tbl4 As Table, _ tbl5 As Table, tbl6 As Table, tbl7 As Table, aRow As Row, aRng As Range Set docCurrent = ActiveDocument strCheckDoc = [path to strCheckDoc document] Debug.Print strCheckDoc Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False) If docRef.Tables.Count > 1 Then Set tbl1 = docRef.Tables(1) 'Full Application Rules Set tbl2 = docRef.Tables(2) 'Background Specific Rules Set tbl3 = docRef.Tables(3) 'Summary Specific Rules Set tbl4 = docRef.Tables(4) 'Brief Description of the Drawings Specific Rules Set tbl5 = docRef.Tables(5) 'Detailed Description Specific Rules Set tbl6 = docRef.Tables(6) 'Claim Specific Rules Set tbl7 = docRef.Tables(7) 'Abstract Specific Rules End If For Each aRow In tbl1.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = docCurrent.Range With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = True .Text = strKeyword Do While .Execute aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl2.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "BACKGROUND", "SUMMARY") With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = True .Text = strKeyword Do While .Execute aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl3.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "SUMMARY", "DRAWINGS") With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = True .Text = strKeyword Do While .Execute aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl4.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "DRAWINGS", "DETAILED") With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = True .Text = strKeyword Do While .Execute aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl5.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "DETAILED", "CLAIMS") With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = True .Text = strKeyword Do While .Execute aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl6.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "CLAIMS", "ABSTRACT") With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = True .Text = strKeyword Do While .Execute aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl7.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "ABSTRACT", "ABSTRACT") With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = True .Text = strKeyword Do While .Execute aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow docRef.Close docCurrent.Activate End Sub Function GetDocRange(aDoc As Document, startWord As String, endWord As String) As Range Dim aRng As Word.Range, iStart As Long, iEnd As Long Set aRng = aDoc.Range With aRng.Find .ClearFormatting .Wrap = wdFindStop .MatchCase = True .MatchWildcards = False .Text = startWord If .Execute Then iStart = aRng.End aRng.End = aDoc.Range.End .Text = endWord If .Execute Then iEnd = aRng.Start If startWord = "ABSTRACT" Then iEnd = aDoc.Range.End If iEnd > iStart Then Set GetDocRange = aDoc.Range(iStart, iEnd) End If End With End Function |
#2
|
|||
|
|||
This should work.
Code:
Sub Test() Highlight "Gregory K. Maxey" End Sub Sub Highlight(ByRef strUser As String) Dim strCheckDoc As String, docRef As Document, docCurrent As Document, trkChg As Boolean Dim wrdRef As String, wrdPara As Paragraph, strKeyword As String, strRule As String Dim cmtRuleComment As Comment, tbl1 As Table, tbl2 As Table, tbl3 As Table, tbl4 As Table, _ tbl5 As Table, tbl6 As Table, tbl7 As Table, aRow As Row, aRng As Range '*** Dim oRngScope As Range Set docCurrent = ActiveDocument strCheckDoc = "D:\strCheckDoc.docx" Debug.Print strCheckDoc Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False) If docRef.Tables.Count > 1 Then Set tbl1 = docRef.Tables(1) 'Full Application Rules Set tbl2 = docRef.Tables(2) 'Background Specific Rules Set tbl3 = docRef.Tables(3) 'Summary Specific Rules Set tbl4 = docRef.Tables(4) 'Brief Description of the Drawings Specific Rules Set tbl5 = docRef.Tables(5) 'Detailed Description Specific Rules Set tbl6 = docRef.Tables(6) 'Claim Specific Rules Set tbl7 = docRef.Tables(7) 'Abstract Specific Rules End If For Each aRow In tbl1.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = docCurrent.Range With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .MatchWholeWord = True .MatchCase = False .MatchWildcards = False '*** True negates MatchCase .Text = strKeyword Do While .Execute aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl2.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "BACKGROUND", "SUMMARY") Set oRngScope = aRng.Duplicate '*** Define the scope With aRng.Find .Text = strKeyword Do While .Execute If Not aRng.InRange(oRngScope) Then Exit For '*** You were falling victim of Find's runaway range. aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl3.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "SUMMARY", "DRAWINGS") Set oRngScope = aRng.Duplicate With aRng.Find .Text = strKeyword Do While .Execute If Not aRng.InRange(oRngScope) Then Exit For aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl4.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "DRAWINGS", "DETAILED") Set oRngScope = aRng.Duplicate With aRng.Find .Text = strKeyword Do While .Execute If Not aRng.InRange(oRngScope) Then Exit For aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl5.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "DETAILED", "CLAIMS") Set oRngScope = aRng.Duplicate With aRng.Find .Text = strKeyword Do While .Execute If Not aRng.InRange(oRngScope) Then Exit For aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl6.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "CLAIMS", "ABSTRACT") Set oRngScope = aRng.Duplicate With aRng.Find .Text = strKeyword Do While .Execute If Not aRng.InRange(oRngScope) Then Exit For aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow For Each aRow In tbl7.Rows strKeyword = Split(Trim(aRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(aRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set aRng = GetDocRange(docCurrent, "ABSTRACT", "ABSTRACT") Set oRngScope = aRng.Duplicate With aRng.Find .ClearFormatting .Text = strKeyword Do While .Execute If Not aRng.InRange(oRngScope) Then Exit For aRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = docCurrent.Comments.Add(Range:=aRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next aRow docRef.Close docCurrent.Activate End Sub Function GetDocRange(aDoc As Document, startWord As String, endWord As String) As Range Dim aRng As Word.Range, iStart As Long, iEnd As Long Set aRng = aDoc.Range With aRng.Find .ClearFormatting .Wrap = wdFindStop .MatchCase = True .MatchWildcards = False .Text = startWord If .Execute Then iStart = aRng.End aRng.End = aDoc.Range.End .Text = endWord If .Execute Then iEnd = aRng.Start If startWord = "ABSTRACT" Then iEnd = aDoc.Range.End If iEnd > iStart Then Set GetDocRange = aDoc.Range(iStart, iEnd) End If End With End Function |
#3
|
|||
|
|||
Darn runaway range. That solved it, thanks!
Now on to figuring out how to make the sections that are searched user-selectable via a userform and condense those 6 virtually identical For loops into a single callable function. |
#4
|
|||
|
|||
For a common process, you could make the docCurrent a module level variable and then pass arguments to:
Code:
Sub ProcessTable(oTbl As Table, strStartWord As String, strEndWord As String, strUser As String) Dim oRng As Row Dim strKeyword As String, strRule As String For Each oRow In oTbl.Rows strKeyword = Split(Trim(oRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(oRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then Set oRng = GetDocRange("DETAILED", "CLAIMS") 'make docCurrent a module level varialbe Set oRngScope = oRng.Duplicate With oRng.Find .Text = strKeyword Do While .Execute If Not oRng.InRange(oRngScope) Then Exit For oRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set cmtRuleComment = m_oDocCurrent.Comments.Add(Range:=oRng, Text:=strUser & ": " & strRule) cmtRuleComment.Author = UCase("WordCheck") cmtRuleComment.Initial = UCase("WC") End If Loop End With End If Next oRow End Sub Function GetDocRange(startWord As String, endWord As String) As Range Dim oRng As Word.Range, iStart As Long, iEnd As Long Set oRng = m_oDocCurrent.Range With oRng.Find .Text = startWord If .Execute Then iStart = oRng.End oRng.End = aDoc.Range.End .Text = endWord If .Execute Then iEnd = oRng.Start If startWord = "ABSTRACT" Then iEnd = aDoc.Range.End If iEnd > iStart Then Set GetDocRange = aDoc.Range(iStart, iEnd) End If End With End Function |
#5
|
|||
|
|||
Ok, I may be in over my head. Here is the concept of what I am attempting, but failing, to do.
I have a UserForm that has 6 toggle buttons and a command button. Each toggle button corresponds to one of the possible sections in the document, which are the words passed to GetDocRange as startWord and endWord. The idea is to click the toggle buttons for the sections that are in a given document and then click the command button to close the UserForm and continue with execution of the macro. Based on which toggle buttons are set to true, corresponding variables should be set to true. Based on the values of those variables, startWord and endWord should be provided. For example, the possible sections as represented by the toggle buttons are Background, Summary, Drawing, Description, Claim, and Abstract. If all sections are present, the code should progress through a first loop with startWord = Background and endWord = Summary, a second loop with startWord = Summary and endWord = Drawing, etc. When startWord is Abstract, endWord should also be Abstract. However, if all sections are not present, that section should be skipped. For example, assume that Summary is not present in some given document. In that case, the toggle buttons for all sections other than Summary are toggled true and the code should progress through a first loop with startWord = Background and endWord = Drawing, a second loop with startWord = Drawing and endWord = Description, etc. When startWord is Abstract, endWord should again be Abstract. I have ToggleButtonX_Change routines for each toggle button in the UserForm that chack whether the button value is true or false, but I'm having trouble figuring out where to stick the variables (and what type they should be) for the loop, as well as figuring out how to set up the loop to do the skips as I described. My thought is some sort of For loop with the index used for the table number as well as selecting which of the section names to use for startWord and endWord, but that's a half-baked thought that I can't seem to round out into an outline for coding. The second thought was combining the For loop and index with a select case statement to evaluate the various possible outcomes, but that thought didn't get much farther than the first. I'm open to any suggestions or advice, and thanks in advance. |
#6
|
|||
|
|||
I've also run into an interesting new issue where docRef.Tables.Count is returning a value of 2 when in fact there are 7 tables in docRef.
|
#7
|
|||
|
|||
You might have to tinker with this a little but I don't see why you would need a userform. I'm assuming the reference document will always have the seven tables:
Code:
Option Explicit Private m_oDocCurrent As Document Sub Test() Highlight "Gregory K. Maxey" End Sub Sub Highlight(ByRef strUser As String) Dim strCheckDoc As String, docRef As Document Dim lngIndex As Long Set m_oDocCurrent = ActiveDocument strCheckDoc = "D:\strCheckDoc.docx" Set docRef = Documents.Open(strCheckDoc, ReadOnly:=True, Visible:=False) For lngIndex = 1 To docRef.Tables.Count Select Case lngIndex Case 1: ProcessTable docRef.Tables(1), strUser Case 2: ProcessTable docRef.Tables(2), strUser, "BACKGROUND", "SUMMARY|DRAWINGS|DETAILED|CLAIMS|ABSTRACT" Case 3: ProcessTable docRef.Tables(3), strUser, "SUMMARY", "DRAWINGS|DETAILED|CLAIMS|ABSTRACT" Case 4: ProcessTable docRef.Tables(4), strUser, "DRAWINGS", "DETAILED|CLAIMS|ABSTRACT" Case 5: ProcessTable docRef.Tables(5), strUser, "DETAILED", "CLAIMS|ABSTRACT" Case 6: ProcessTable docRef.Tables(6), strUser, "CLAIMS", "ABSTRACT" Case 7: ProcessTable docRef.Tables(7), strUser, "ABSTRACT", "ABSTRACT" End Select Next lngIndex docRef.Close m_oDocCurrent.Activate lbl_Exit: Exit Sub End Sub Sub ProcessTable(oTbl As Table, strUser As String, _ Optional strStartWord As String = vbNullString, Optional strEndWord As String = vbNullString) Dim oRng As Range, oRngScope As Range Dim oRow As Row Dim strKeyword As String, strRule As String Dim oComment As Comment Dim arrEndWords() As String Dim lngIndex As Long For Each oRow In oTbl.Rows strKeyword = Split(Trim(oRow.Range.Cells(1).Range.Text), vbCr)(0) strRule = Split(Trim(oRow.Cells(2).Range.Text), vbCr)(0) If strKeyword <> "" Then If Not strStartWord = vbNullString Then 'Process defined sections arrEndWords = Split(strEndWord, "|") For lngIndex = 0 To UBound(arrEndWords) Set oRng = GetDocRange(strStartWord, arrEndWords(lngIndex)) If Not oRng Is Nothing Then Exit For Next lngIndex Else 'Process whole document Set oRng = m_oDocCurrent.Range End If If Not oRng Is Nothing Then Set oRngScope = oRng.Duplicate With oRng.Find .Text = strKeyword Do While .Execute If Not oRng.InRange(oRngScope) Then Exit For oRng.HighlightColorIndex = wdTurquoise If strRule <> "" Then Set oComment = m_oDocCurrent.Comments.Add(Range:=oRng, Text:=strUser & ": " & strRule) oComment.Author = UCase("WordCheck") oComment.Initial = UCase("WC") End If Loop End With End If End If Next oRow End Sub Function GetDocRange(startWord As String, endWord As String) As Range Dim oRng As Word.Range, lngStart As Long, lngEnd As Long Set oRng = m_oDocCurrent.Range With oRng.Find .Text = startWord If .Execute Then lngStart = oRng.End oRng.End = m_oDocCurrent.Range.End .Text = endWord If .Execute Then lngEnd = oRng.Start If startWord = "ABSTRACT" Then lngEnd = m_oDocCurrent.Range.End If lngEnd > lngStart Then Set GetDocRange = m_oDocCurrent.Range(lngStart, lngEnd) End If End With End Function You have had your hand out quite far here ;-). People do this sort of thing for a living so don't always expect your solutions to be handed to you. |
#8
|
|||
|
|||
Greg,
Thank you very much for your assistance, it is greatly appreciated. I would like to respectfully mention one thing though. I am most assuredly grateful for the code sections that you provided, but I take slight issue with the "had your hand out quite far here" portion. I am well aware that people do this for a living, and my small project is to make my personal life a bit easier and as a learning experience. If you'll please note, I asked if anyone saw the error that I was making, and then later asked for suggestions or advice. I never asked for code to be written for me and have had my nose in the VBA developer notes over on Microsoft's website and other resources to learn and understand the the coding, but I recognize that "textbooks" are no replacement for practical experience, which is why I came here for guidance to be pointed in the right direction based on other's experience for further research and learning. Again, I truly appreciate your assistance and your taking the time to provide functioning code. It works almost perfectly and the one use case for which it isn't quite functioning properly when a section is missing from the reference document is something that I will work through and debug. |
#9
|
|||
|
|||
rekent,
Fair enough. Chalk it up as a bad day. I apologize. With your test documents provided, I removed the section "SUMMARY" and the code seemed to work as expected. That was the extent of the testing so not surprised you have found some issues. If you need more help, post back. |
#10
|
|||
|
|||
Tracked it down. GetDocRange was returning an incorrect value for oRng because when the SUMMARY section was missing, "SUMMARY" was not found and lngStart remained at zero. But the next section header "DRAWINGS" was found, creating a range from document start to the beginning of "DRAWINGS." The nested If statements at the end of this function seem to do the trick, and I haven't been able to come up with a scenario yet in which they break other functionality.
Code:
Function GetDocRange(startWord As String, endWord As String) As Range Dim oRng As Word.Range, lngStart As Long, lngEnd As Long Set oRng = m_oDocCurrent.Range With oRng.Find .Wrap = wdFindStop .MatchCase = True .Text = startWord If .Execute Then lngStart = oRng.End oRng.End = m_oDocCurrent.Range.End .Text = endWord If .Execute Then lngEnd = oRng.Start If startWord = "ABSTRACT" Then lngEnd = m_oDocCurrent.Range.End If lngStart = "0" Then Set GetDocRange = m_oDocCurrent.Range(lngStart, lngStart) Else If lngEnd > lngStart Then Set GetDocRange = m_oDocCurrent.Range(lngStart, lngEnd) End If End If End With End Function |
#11
|
|||
|
|||
rekent,
lngStart is a long variable and you are checking it against a string "0" Does it still work if your make that: If lngStart = 0 |
#12
|
|||
|
|||
Interestingly, it seems to work both ways.
|
#13
|
|||
|
|||
Not really, the compiler will resolve strings to long:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey MsgBox "4" * "5" lbl_Exit: Exit Sub End Sub |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Range method Find can't find dates | jmcsa3 | Excel Programming | 1 | 05-02-2020 06:56 AM |
Find if Date range falls within another range | Triadragon | Excel | 3 | 05-02-2016 11:48 AM |
Find a Date in a Range | rspiet | Excel | 3 | 02-15-2016 08:37 AM |
find IP in range / find number between numbers | gn28 | Excel | 4 | 06-14-2015 03:46 PM |
Find and Replace within range | anil3b2 | Word VBA | 3 | 12-01-2010 02:35 AM |