новая строка добавляется в table (). cell (). range.text в макросе слова

Question

Когда я копирую текст из ячейки таблицы, используя docCurrent.Tables (x) .Cell (x, y) .Range.Text, новая строка добавляется вместе с текстом в ячейке.

Код, который я использовал:

Sub tabele_trasfer()
'
' tabele_trasfer Macro
'
'
Dim docCurrent As Document
Dim docNew As Document
Dim myRange As Range

Set docCurrent = ActiveDocument
Set docNew = Documents.Add
Set myRange = docNew.Range(0, 0)

docNew.Tables.Add Range:=myRange, NumRows:=docCurrent.Tables(5).Rows.Count, NumColumns:=docCurrent.Tables(5).Columns.Count

For i = 1 To docCurrent.Tables(5).Rows.Count
    docNew.Tables(1).Cell(Row:=i, Column:=1).Range.Text = docCurrent.Tables(5).Cell(i, 2).Range.Text
    docNew.Tables(1).Cell(Row:=i, Column:=2).Range.Text = docCurrent.Tables(5).Cell(i, 2).Range.Text
Next i

End Sub

Answer 1

Похоже, вы заполняете оба столбца в новом документе одними и теми же данными.Попробуйте:

Sub tabele_trasfer()
'
' tabele_trasfer Macro
'
'
Dim docCurrent As Document
Dim docNew As Document
Dim myRange As Range

Set docCurrent = ActiveDocument
Set docNew = Documents.Add
Set myRange = docNew.Range(0, 0)

docNew.Tables.Add Range:=myRange, NumRows:=docCurrent.Tables(5).Rows.Count, NumColumns:=docCurrent.Tables(5).Columns.Count

For i = 1 To docCurrent.Tables(5).Rows.Count
    Set myRange = docCurrent.Tables(5).Cell(i, 2).Range
    myRange.End = myRange.End - 1
    docNew.Tables(1).Cell(i, 1).Range.Text = myRange.Text
    docNew.Tables(1).Cell(i, 2).Range.Text = myRange.Text
Next i

End Sub

Если заполнение обоих столбцов в новом документе одними и теми же данными не является вашим намерением, используйте:

    Set myRange = docCurrent.Tables(5).Cell(i, 2).Range
    myRange.End = myRange.End - 1

еще раз, чтобы указать на правильный источник перед выводом второгострока.

Answer 2

Причина в том, что конец ячейки таблицы содержит два символа: Chr (13) и Chr (7) - метка абзаца и маркер конца ячейки.Вы можете отключить их, чтобы сохранить только текст.

Я предоставил функцию, которую я использую для этой цели, которая берет ячейку Range и возвращает строковое значение ниже.Вот одна из ваших строк, измененная для использования функции

docNew.Tables(1).Cell(Row:=i, Column:=1).Range.Text = _
           TrimCellText(docCurrent.Tables(5).Cell(i, 2).Range)

и функции

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