此程序从.xlsx文档运行,并更改关联的.docx文档,替换两个标记之间的选定文本。迭代1-8按预期工作,但在第9次迭代的中途,范围偏移50个字符,并在剩余迭代中保持偏移50个字符。特别是在第9次迭代时,startPos仍然正确,但stopPos偏移-50。然后,在第10次迭代中,startPos从stopPos停止的地方开始,向后返回-50个字符。
引用的excel工作表的格式为:
- |关闭标签1|替换|替换|Replacement|
- |关闭标签2|替换|替换|Replacement|
- 等等
Public subWordFindAndReplaceTEST()
'<----------------------------- Declarations ----------------------------->
Dim msWord As Object
Dim doc As Word.Document
Dim documentText As String
Dim firstTerm As String, secondTerm As String
Dim toReplaceTerm As String, replacementTerm As String
Dim masterSheet As String 'Easy editing of xlsx worksheet name
Dim cellIterator As Integer
Dim cellStart As Integer 'Row number that Tags start on
Dim tag1Col As String * 1, tag2Col As String * 1, _
toReplaceCol As String * 1, replacementCol As String * 1 'Variables that point to xlsx rows
Dim readFilePath As String, writeFilePath As String
Dim startPos As Long 'Stores the starting position of firstTerm
Dim stopPos As Long 'Stores the starting position of secondTerm based on first term's location
Dim beginPosition As Long 'The next position to search for the firstTerm
Dim myRange As Word.Range 'Total range of the section between firstTerm and secondTerm
'<----- Easy Variable Updating ----->
'FilePath to read from
readFilePath = Application.ActiveWorkbook.Path & "\ReportDoc.docx"
'User Input for FilePath to write to (Paths directly to folder xlsx sheet is in)
writeFilePath = InputBox("What would you like to save this file as?" _
& vbLf & vbLf & vbLf & Application.ActiveWorkbook.Path & "\", "Save As", "TestDocument.docx")
If writeFilePath = "" Then Exit Sub 'Exits if user hits "Cancel"
'Xlsx Variables
masterSheet = "Replace Example" 'Name of the xlsx sheet to search for tags
cellStart = 2 'Row of the first instance of tags
tag1Col = "A" 'Column of the section begin tags
tag2Col = "B" 'Column of the section end tags
toReplaceCol = "C" 'Column of text that represents variable to replace
replacementCol = "D" 'Column of text to replace variable
'<---------------------------------->
'<--------------------------- Document Opening --------------------------->
'Error catching required for opening document
On Error Resume Next
Set msWord = GetObject(, "Word.Application")
If msWord Is Nothing Then
Set msWord = CreateObject("Word.Application")
End If
On Error GoTo 0
'Setting data values from designated xlsx cells
cellIterator = cellStart
With Worksheets(masterSheet)
firstTerm = .Range(tag1Col & cellIterator).Value2
secondTerm = .Range(tag2Col & cellIterator).Value2
toReplaceTerm = .Range(toReplaceCol & cellIterator).Value2
replacementTerm = .Range(replacementCol & cellIterator).Value2
End With
'Opening document
With msWord
.Visible = True
Set doc = .Documents.Open(readFilePath)
.Activate
'Saving as new document
doc.SaveAs2 Filename:=Application.ActiveWorkbook.Path & "\" & writeFilePath, _
FileFormat:=wdFormatDocumentDefault
'<----------------------------- Rangefinding ----------------------------->
'Repeating process until cells are empty
Do While firstTerm <> ""
'Resetting Variables
startPos = 0
stopPos = 0
'Get all the document text and store it in a variable.
documentText = doc.Content
Set myRange = doc.Range 'Initializing myRange object
beginPosition = 1 'Setting beginning position
'Error catch begin
On Error Resume Next
'<--------- Getting range ---------->
startPos = InStr(beginPosition, documentText, firstTerm, vbTextCompare)
'Issue arises here on 9th iteration
stopPos = InStr(startPos, documentText, secondTerm, vbTextCompare)
'<---------------------------------->
'Basic error catch for invalid input
If Err.Number <> 0 Then
If Err.Number = 5 Then
'Immediately quits document without saving
'Prevents errors with rerunning the macro
.Quit SaveChanges:=False
MsgBox Err.Description & vbLf & "Make sure tags being searched for are in the document."
Exit Sub
Else
'Error catching for alternative issues
MsgBox Err.Description
End If
End If
'Reset Error
On Error GoTo 0
'Shows start/end tags compared to actual start/end position
'MsgBox doc.Range(startPos, startPos + Len(firstTerm)) & " || " & firstTerm & _
vbLf & doc.Range(stopPos, stopPos + Len(secondTerm)) & " || " & secondTerm '~DL
myRange.SetRange Start:=startPos, End:=stopPos
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = toReplaceTerm
'Handles strings too long for Find
If Len(replacementTerm) > 250 Then
'User Defined
stringOverflow replacementTerm, toReplaceTerm, myRange, doc
Else
.Replacement.Text = replacementTerm
End If
'Formatting options
.Replacement.Font.Italic = False
.Replacement.Highlight = False
.Forward = True
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll
End With
'Iterates to next row in Excel
cellIterator = cellIterator + 1
With Worksheets("Replace Example")
firstTerm = .Range(tag1Col & cellIterator).Value2
secondTerm = .Range(tag2Col & cellIterator).Value2
toReplaceTerm = .Range(toReplaceCol & cellIterator).Value2
replacementTerm = .Range(replacementCol & cellIterator).Value2
End With
Loop
字符串
结束子
我已经尝试在循环之间重置所有变量,我相当有信心,尽管在第9次迭代之后偏移量是一致的,但偏移量在每个循环中都被重新创建,而不是结转。
我发现问题出现在第一个InStr()和第二个InStr()之间的“获取范围”部分。我已经检查过了,我相信这个问题不是因为使用的任何字符串超过了最大长度,也不是因为每个部分或整个文档的长度。
编辑:我尝试使用stopPos = InStr(beginPosition,documentText,secondTerm,vbTextCompare)来使stopPos独立于startPos,并且在相同的位置发生相同的问题。
2条答案
按热度按时间8oomwypt1#
无论您为
startPos
获取什么值,在该位置必须有与您的firstTerm
匹配的值。也许该文档中有多个匹配项,并且您期望第二个匹配项,但InStr
给您的是第一个匹配项?尝试在第一个
InStr
下面添加以下行:字符串
这将显示正在找到的匹配项,以及匹配项之前/之后的20个字符。
t40tm48m2#
如果有人遇到这个问题,我设法使用Find函数返回文档中的确切范围,无论是否有隐藏或格式化字符:
字符串
结束函数