VBA Word在插入文本时避免换行

VBA Word在插入文本时避免换行,vba,ms-word,Vba,Ms Word,我有以下代码,可以正常工作,只有一个例外。“MM.Content.InsertAfter Total”行插入文本,但也插入换行符(例如,在“topic”和“[”)之间,这是我不想要的。如何防止Word这样做 Sub Schleife_VAR() Dim Dok As Word.Document Set Dok = ThisDocument Dim Tabelle As Table Dim Cell As Range Dim counter As Integ

我有以下代码,可以正常工作,只有一个例外。“MM.Content.InsertAfter Total”行插入文本,但也插入换行符(例如,在“topic”和“[”)之间,这是我不想要的。如何防止Word这样做

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

在抱怨之前,你应该阅读本论坛的发布规则

查看了上面的代码后,您始终在MM指定的文档末尾添加文本,因为您引用的是Content属性。因此,以下段落适用

但是,如果范围以段落标记结束,则 在文档末尾,Microsoft Word将在 最后一段标记,而不是在末尾创建新段落 该文件的附件

所以我感觉到了你的痛苦。当我尝试在“Hello World”之后使用ActiveDocument.Content.Inserta插入诸如“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)

看看这是否能解决您的问题。

问题中的代码中没有声明使用的许多变量。这使得故障排除变得不确定

假设它们应该保存字符串数据而不是单词范围,那么问题来自
Tabelle.Cell(i,2).Range
整个单元格的内容包括单元格结尾字符ANSI 13&ANSI 7;ANSI 13是一个段落标记-这将生成新行。我使用一个函数来修剪单元格的内容,可按如下方式使用

(注意:在Word中查询某个范围的字符串内容时,最好使用
range.Text
,而不仅仅是
range
。VBA非常宽容,并且对对象使用默认属性(例如范围的
Text
),但有时它会出错,例如当变量未明确定义为
字符串时


将光标放在后面的插入符上。按F1。阅读页面,特别是备注的第二段。很抱歉,我仍然不明白,第二段说:您可以使用Visual Basic Chr函数和InsertAfter方法插入引号、制表符和不间断连字符等字符。您还可以使用以下Visual Basic常量:vbCr、vbLf、vbCrLf和vbTab。“我这样做了,但仍然不确定为什么我没有解决一个错误——这是第三段。我也阅读了下一段。我还尝试了示例代码,但没有成功。VBA在“.start”处标记了一个错误,表示找不到此方法。你能告诉我吗?;)Sry,但我从来没有收到过如此糟糕的帮助。我不认为发布我的文档的个人路径有任何价值。总之,我找到了一个解决方案。我查找链接并将其发布在这里。
 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