vba Word-。始终在选择范围之外找到匹配项，从而无限地循环

Question

当将表从pdf转换为单词时，我最终得到了类似于以下格式：

（[space]是一个空格字符）

text [space.spac.spacing 10pts] text [space.space.spacing 30pts]文本

文本[space.space.spacing 14pts ] text [space.pacing 31分]文本

space.spacing 33pts]文本

不是带有3列和3行包含每个«文本'的

space.spacing 12ts ]	文本[	[
常规	而	表
文本	PDF转换中的文本	文本

不用创建列，而是通过调整[空格]来模仿列。

因此，我的想法是，应该通过识别转换后表的每个段落的每个空间的间距来重新创建表格，最终用可识别的符号代替它们，以便我可以在稍后将文本转换为表格。

我的想法在某种程度上是以下内容：

 ' For each paragraph of the selected text (which is the converted table)
    ' Find all [space] within the paragraph range
        ' If a [space] is found, check its spacing
            ' 1st case : [space].spacing is <= 1 pts (so a normal space)
                ' Do nothing
            ' 2nd case : [space].spacing is >= 10 pts (so previous Text is supposed to be within a small column) 
                ' insert ££ (symbol for small column)
            ' 3rd case [space].spacing is >= 30 pts (so previous Text is supposed to be within a small column) 
                ' insert §§ (symbol for large column)
 ' Once all [space] are found within the current paragraph, do the same with the next paragraph, until the last paragraph of the selected text 

我当前的代码如下：

Private Sub Test()
Dim RngSearch As Range
Dim RngCurrent As Range
Dim Paragraph As Paragraph

For Each Paragraph In ActiveDocument.Paragraphs
    Set RngCurrent = Paragraph.Range
    RngCurrent.Select 'For testing purposes
    With RngCurrent.Find
        .Text = " "
        Do While RngCurrent.Find.Execute
            RngCurrent.Select 'For testing purposes
            Select Case RngCurrent.Font.Spacing
                Case Is >= 30
                    RngCurrent.Font.Spacing = 1
                    RngCurrent.InsertAfter ("§§")
                Case Is >= 10
                    RngCurrent.Font.Spacing = 1
                    RngCurrent.InsertAfter ("¤")
                Case Else
                    ' Do Nothing
            End Select
        Loop
    End With
Next Paragraph
End Sub

因此，它有点有一个问题：它无限地循环。每次完成文本时，它都会无限期地返回。

我设法将问题跟踪到以下代码：

    With RngCurrent.Find
        .Text = " "
        Do While RngCurrent.Find.Execute
            RngCurrent.Select
            ' Use Case function
        Loop
    End With

没有它，通过段落的循环正常起作用（在最后一段结束），

    For Each Paragraph In ActiveDocument.Paragraphs
        Set RngCurrent = Paragraph.Range
        RngCurrent.Select
        ' Code here
    Next Paragraph

但是一旦.find.text（“”）注入了，它实际上是不再像我想象的那样在rngcurrent.find.execute应该建立的那样不再查看。

我觉得解决方案是非常愚蠢的，但是我一直在寻找两天的原因。每次我使用.find（“”）时，每次都会停止按照我的浮标行动。

我已经尝试使用.wrap = wdfindstop，但是它在段落的第一场比赛中停止，并过早地转到下一段。

    With RngCurrent.Find
        .Text = " "
        .wrap = wdFindStop
        Do While RngCurrent.Find.Execute
            RngCurrent.Select
            ' Use Case function
        Loop
    End With

奇怪的是.wrap = wdfindask什么都不问我...也许这意味着什么。

我相信这是因为每个段落中总是有空间？这样它可以无限期地循环吗？

Answer 1

您方式过于复杂的事情：

Sub MakeTable()
Application.ScreenUpdating = False
Dim i As Single
With Selection
  i = .Characters.First.Font.Size
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindStop
    .Text = " "
    .Replacement.Text = "^t"
    .Replacement.Font.Size = i
    .Font.Size = 10
    .Execute Replace:=wdReplaceAll
    .Font.Size = 30
    .Execute Replace:=wdReplaceAll
  End With
  .ConvertToTable Separator:=vbTab
End With
Application.ScreenUpdating = True
End Sub

Answer 2

因此，我终于发现并不完全是解决方案，而是对于可能需要类似解决方案的任何人的解决方法。我决定走“硬”路径，而不是使用.find =“”，并检查段落中的每个单词（在MS Word中，似乎以[Space]字符结束）。然后，如果其间距优于值，我检查单词的最后一个字符（通常是一个空间）。情况，做点什么。

For Each RngWord In Paragraph.Range.Words
    Set RngChar = RngWord.Characters.Last
    Select Case RngChar.Font.Spacing
        Case Is > 300
            RngChar.Font.Spacing = 1
            RngChar.InsertAfter ("£")
        Case Is > 100
            RngChar.Font.Spacing = 1
            RngChar.InsertAfter ("#")
        Case Is > 15
            RngChar.Font.Spacing = 1
            RngChar.InsertAfter ("¤")
        Case Else
            ' Do Nothing
    End Select
Next RngWord

它可以完成这项工作，而且不是那么慢，但是我想有更好的解决方案:)