【发布时间】:2013-04-09 16:36:31
【问题描述】:
我正在创建一个项目,允许用户在 excel 中创建任务列表,然后将用户创建的任务文本与预制 Word 文档中的第二个标题文本(标题 2)进行比较。我能够获取第二个标题文本并将其保存到数组中,然后获取用户任务列表并将其保存在数组中。然后我尝试使用该函数查看程序中的任务文本(第二个标题)是否在用户任务列表中
If IsError(Application.Match(ProgArray(x), TaskArray, 0)) Then
'Find within word document and highlight red
End if
我遇到的问题是这总是返回错误,因为出于某种原因,即使内置的监视屏幕调试器另有说明,word 文档中的文本也不等于 excel 表中的完全相同的文本。
起初我使用比较文本软件来确定 word 中的标题文本实际上可能复制了额外的一行。 图片说明:
但后来我尝试修剪,并检查标题文本是否有 vbNewLine
If Right$(StrFound, 2) = vbCrLf Or Right$(StrFound, 2) = vbNewLine Then
也无济于事,因为这个 if 语句从未被触发过。
我的问题是,从 word 文档中获取文本是否还会提取一些我刚刚丢失的隐藏值,如果是这样,有什么办法解决这个问题吗?谢谢你,对文字墙感到抱歉。
最后这里是我的完整代码:(它不漂亮,因为我现在只是为了功能)
'Sub CheckHeader()
Dim blnFound As Boolean
Dim StrFound As String
Dim x As Integer, y As Integer, z As Integer
Dim TaskTotal As Integer
Dim ProgArray(149) As String
Dim TaskArray() As String
Dim NotInArray() As String
Dim NotInProg() As String
Dim appWd As Object
Dim TaskSheet As Worksheet
Set appWd = GetObject(, "Word.Application")
Set wdFind = appWd.Selection.Find
Set TaskSheet = Sheets("Task List")
'Get Task List from Excel
TaskTotal = TaskSheet.Cells(TaskSheet.Rows.Count, 1).End(xlUp).Row - 1
ReDim TaskArray(TaskTotal) As String
ReDim NotInProg(TaskTotal) As String
ReDim NotInArray(TaskTotal) As String
'Get User task list into an array to compare - 0 to 0 is for testing
For x = 0 To 0 'TaskTotal - 1
TaskArray(x) = TaskSheet.Cells(2 + x, 5).Value '+ " (" & TaskSheet.Cells(2 + x, 1).Value + " " _
& TaskSheet.Cells(2 + x, 3).Value + ": " & TaskSheet.Cells(2 + x, 4).Value + ")"
Next x
x = 0
y = 0
'Find all instances of Headings
With ActiveDocument.Range.Find
'.Text = "Test"
.Style = "Heading 2"
Do
blnFound = .Execute
If blnFound Then
'MsgBox .Parent.Text
StrFound = .Parent.Text
'StrFound = Right(StrFound, InStr(StrFound, ")") + 1)
StrFound = CStr(StrFound)
TaskSheet.Cells(2 + x, 120).Value = StrFound
'At first I thought it was also saving a new line but I couldn't get rid of it
If Right$(StrFound, 2) = vbCrLf Or Right$(StrFound, 2) = vbNewLine Then
z = 1
End If
ProgArray(x) = TaskSheet.Cells(2 + x, 120)
'StrFound
x = x + 1
Else
Exit Do
End If
Loop
End With
'Compare if List is in Program
For x = 0 To 149
If x < TaskTotal - 1 Then
If IsError(Application.Match(TaskArray(x), ProgArray, 0)) Then
NotInProg(y) = TaskArray(x)
y = y + 1
End If
End If
'If the header is not within the user created task list then run this case
If IsError(Application.Match(ProgArray(x), TaskArray, 0)) Then
'used for debugging, for some reason the header text is larger than the user text
MsgBox StrComp(ProgArray(x), TaskArray(x))
NotInArray(z) = ProgArray(x)
SearchName = NotInArray(z)
'Increase element
z = z + 1
'Check Program and highlight to show that what is in the program is not in the user task list
With wdFind
.Text = SearchName
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Execute
End With
If wdFind.Found Then
'MsgBox " Found it"
appWd.Selection.Range.HighlightColorIndex = wdRed
Else
MsgBox ProgArray(x) + " is not in TaskList"
End If
Else
'Otherwise it is in the program and if it was red, unhighlight the text
SearchName = TaskArray(x)
With wdFind
.Text = SearchName
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Execute
End With
If wdFind.Found Then
'MsgBox " Found it"
appWd.Selection.Range.HighlightColorIndex = wdNoHighlight
' For not in task Selection.Range.HighlightColorIndex = wdRed
' For not in prog Selection.Range.HighlightColorIndex = wdYellow
Else
MsgBox TaskArray(x) + " is not here"
End If
End If
'Lastly Check for Ordering
Next x
End Sub'
【问题讨论】:
-
您是否尝试在 Word 中剪切找到范围的最后一个标记?试着把这行:
.Parent.SetRange .Parent.Start, .Parent.End - 1放在前面:StrFound = .Parent.Text -
.Parent.Text 确实是问题所在,您的输入实际上解决了新行问题,但现在我无法循环浏览工作表,因为它的范围停留在它找到的第一件事上。不是Word的粉丝哈哈。感谢您的帮助!
-
尝试在
x=x+1之后添加.Parent.MoveEnddo...loop。 -
哦,我亲爱的宝贝耶稣。谢谢,这解决了所有问题,让我无法处理我新的混乱工作,这让我想用最尖的棍子戳自己。
-
能否再次将此问题标记为已解决。上一个答案因不完整而被删除。
标签: vba excel compiler-errors ms-word