vba单词在插入文本时避免断路

Question

i具有以下代码，一个例外情况正常。" mm.content.insertafter总计"行插入了文本，但也插入了线断裂（例如，在"主题"one_answers" ["）之间，这是我不想要的。我该如何阻止言语这样做？

Sub Schleife_VAR()
    Dim Dok As Word.Document
    Set Dok = ThisDocument
    Dim Tabelle As Table
    Dim Cell As Range
    Dim counter As Integer
    Dim i As Integer
    Dim Number As Integer
    Dim MM As Word.Document
    Set MM = Documents.Open("C:Users)
    For Each Tabelle In Dok.Tables
        Number = Dok.Range(0, Tabelle.Range.End).Tables.Count
        counter = Dok.Tables(Number).Rows.Count
        For i = 1 To counter
            Dim j As Integer
            If InStr(1, Tabelle.Cell(i, 1).Range.Text, "TOPIC") Then
                    Dim Topic As String
                    Topic = Tabelle.Cell(i, 2).Range
            ElseIf InStr(1, Tabelle.Cell(i, 1).Range.Text, "VAR") Then
                    Dim Total As String
                    Total = Topic & " " & "[" + Tabelle.Cell(i, 2).Range & "]"
                    MM.Content.InsertAfter Total
            ElseIf InStr(1, Tabelle.Cell(i, 1).Range.Text, "FILTER") Then
                    MM.Content.Paragraphs.Last.Range.Style = MM.Styles("Filter")
                    MM.Content.InsertAfter "Filter: " & Tabelle.Cell(i, 2).Range    
            ElseIf InStr(1, Tabelle.Cell(i, 1).Range.Text, "QUESTION") Then
                  MM.Content.Paragraphs.Last.Range.Style = MM.Styles("Question")
                  MM.Content.InsertAfter Tabelle.Cell(i, 2).Range
            End If
            MM.Content.Paragraphs.Last.Range.Style = MM.Styles("Remark")
        Next
    Next
    Selection.Range.Case = wdTitleSentence
End Sub

Answer 1

问题中的代码中未声明所使用的许多变量。这使得解决这一不确定。

在假设上，这些应该持有字符串数据，而不是单词。然后问题来自 Tabelle.Cell(i, 2).Range，整个单元格的内容包括细胞结束字符ANSI 13＆amp;ANSI 7;ANSI 13是段落标记 - 这生成了新行。我使用一个函数来修剪单元格的内容，该内容可用如下。

（注意：在Word中查询范围的字符串内容时，最好使用Range.Text，而不仅仅是Range。VBA非常宽容，并将默认属性用于对象（例如 Text for Angars），但有时可以使其制造错误，例如变量未明确定义为String时。）

 Topic = TrimCellText(Tabelle.Cell(i, 2).Range.Text)
Function TrimCellText(r As word.Range) As String
    Dim sLastChar As String
    Dim sCellText As String
    sCellText = r.Text
    sLastChar = Right(sCellText, 1)
    Do While sLastChar = Chr(7) Or sLastChar = Chr(13)
        sCellText = Left(sCellText, Len(sCellText) - 1)
        sLastChar = Right(sCellText, 1)
    Loop
    TrimCellText = sCellText
End Function

Answer 2

抱怨之前，您应该阅读此论坛上发布的规则。

查看了上面的代码，您一直将文本添加到MM指定的文档末尾，因为您是指内容属性。因此，以下段落适用。

但是，如果范围以段落标记结束，也发生 成为文档的结尾，Microsoft Word在 最终段落标记，而不是在最后创建新段落 文档。

所以我感到你的痛苦。当我尝试使用ActivedOcument.Content.Intertafter" Hello World"插入诸如" Hello World"之类的文本时，它可以正常工作。因此，我只能建议您从Tabelle获得的文本具有新的行或其他一些不可见的字符，该字符嵌入了单元文本开始时。我无法测试它，因为我没有源文档的副本。打开格式视图时，您会看到什么？（单击"段落"选项卡上的反向p，查找从单元格的第一行开始的单元文本，没有明显的" zwielichtig"字符。）。）。

下面是您的代码，就像我写的那样。

选项显式

Sub Schleife_VAR()
Dim Dok As Word.Document
Dim Tabelle As Table
Dim Cell As Range
'Dim counter As Integer
'Dim i As Integer
'Dim Number As Integer
Dim MM As Word.Document
'Dim j As Integer
Dim my_row                            As Word.Row
Dim my_cell1_text                     As String
Dim my_cell2_text                     As String
Dim Topic As String
Dim Total As String
'Set MM = Documents.Open("C:Users) where is the rest?
    Set MM = ActiveDocument
    Set Dok = ThisDocument  ' Bad practise.  ThisDocument refers
                            ' to the Document holding the macro code.
                            ' Typically this is the Template on which the
                            ' Document is based. Your usage may be different.
    ActiveDocument.Content.InsertAfter "Hello World"
    For Each Tabelle In Dok.Tables
        'Number = Dok.Tables.Count
        'counter = Dok.Tables(Number).Rows.Count
        For Each my_row In Tabelle.Range.Rows
        'For i = 1 To counter
            my_cell1_text = my_row.Range.Cells(1).Range.Text
            my_cell2_text = my_row.Range.Cells(2).Range.Text
            Select Case my_cell1_text
                Case "TOPIC"
                    'If InStr(1, Tabelle.Cell(i, 1).Range.Text, "TOPIC") Then
                    ' Topic = Tabelle.Cell(i, 2).Range
                    Topic = my_cell2_text
                Case "VAR"
                    ' ElseIf InStr(1, Tabelle.Cell(i, 1).Range.Text, "VAR") Then
                    ' Total = Topic & " " & "[" + Tabelle.Cell(i, 2).Range & "]"
                    Total = Topic & " [" & my_cell2_text & "]"
                    MM.Content.InsertAfter Total
                Case "Filter"
                    ' ElseIf InStr(1, Tabelle.Cell(i, 1).Range.Text, "FILTER") Then
                    ' MM.Content.Paragraphs.Last.Range.Style = MM.Styles("Filter")
                    ' MM.Content.InsertAfter "Filter: " & Tabelle.Cell(i, 2).Range
                    MM.Content.InsertAfter "Filter: " & my_cell2_text
                    MM.Content.Paragraphs.Last.Range.Style = MM.Styles("Filter")

                Case "QUESTION"
                    ' ElseIf InStr(1, Tabelle.Cell(i, 1).Range.Text, "QUESTION") Then
                    ' MM.Content.Paragraphs.Last.Range.Style = MM.Styles("Question")
                    ' MM.Content.InsertAfter Tabelle.Cell(i, 2).Range
                    MM.Content.InsertAfter my_cell2_text
                    MM.Content.Paragraphs.Last.Range.Style = MM.Styles("Question")
                Case Else
                    ' Do nothing ?
            End Select
            MM.Content.Paragraphs.Last.Range.Style = MM.Styles("Remark")
        Next
    Next
' There is no selection made in this method so I don't know to what the next line is referring.
Selection.Range.Case = wdTitleSentence
End Sub

下面是一个函数，它将从字符串中删除任何狡猾的字符。我将其用于清理文件名。

Public Function Sanitise(ByVal this_string As String) As String
    Dim my_regex               As VBScript_RegExp_55.RegExp
    Set my_regex = New VBScript_RegExp_55.RegExp
    my_regex.Global = True
    my_regex.MultiLine = True
    my_regex.Pattern = "[^\w:.]"
    Sanitise = my_regex.Replace(this_string, vbNullString)
End Function

您可以使用

my_cell2_text= Sanitise(my_row.Range.Cells(2).Range.Text)

看看是否可以解决您的问题。