Question

我有用于从Excel编写Word文档的代码。当前，从Excel粘贴到Word的每个表之后，Word文档中将出现空行。我在想是否可以在粘贴每个表格后删除一行，或者有更好的建议吗？

我当前的代码：

Set xlRng = ThisWorkbook.Sheets("Document").Range("G3", ThisWorkbook.Sheets("Document").Range("G" & Rows.Count).End(xlUp))

Set wdRng = .Range.Characters.Last

For Each Cell In xlRng
    wdRng.InsertAfter vbCr & Cell.Offset(0, -5).Text
    Select Case LCase(Cell.Value)

    Case "table6"
      ThisWorkbook.Sheets("Tables").Range("B817:C820").Copy
        With wdRng
        Set rngPara = .Paragraphs.Last.Range
        rngPara.Style = "Data"
        rngPara.PasteExcelTable False, False, False
        .Tables(.Tables.Count).Range.Paragraphs.Indent
        .Font.Hidden = 0
        '.Range.Paragraphs(-1).Range.Delete
        Set rngPara = Nothing
        End With

    End Select
Next Cell

我尝试使用.Range.Paragraphs(-1).Range.Delete（在我的代码中注释）没有成功。这种操作的正确命令是什么？

即使删除前一段的解决方案也会有所帮助。我可以为此创建自己的大小写，并在每个表之后执行此命令。

编辑：

如果有人要测试，这里是完整代码：

Sub opentemplateWord()
    Dim Paragraphe As Object, WordApp As Object, WordDoc As Object
    Dim wSystem As Worksheet
    Dim Cell As Range
    Dim wdRng As Object 'Word.Range
    Dim xlRng As Excel.Range
    Dim tempFolderPath As String
    Dim filePath As String
    Dim fileTitle As String
    Dim rngPara As Object

    'Application.ScreenUpdating = False

    On Error GoTo ErrorHandlerEndExecution

    Set wSystem = ThisWorkbook.Sheets("Templates")

    Dim File: File = Environ("Temp") & "\" & "Document_template" & ".docx"
    'creationsession Word
    Set WordApp = CreateObject("Word.Application")
    'word ll be close to run
    WordApp.Visible = False
    'open the file .doc
    Set WordDoc = WordApp.Documents.Open(File)

    With WordDoc

    Set xlRng = ThisWorkbook.Sheets("Document").Range("G3", ThisWorkbook.Sheets("Document").Range("G" & Rows.Count).End(xlUp))

    Set wdRng = .Range.Characters.Last

    For Each Cell In xlRng
        wdRng.InsertAfter vbCr & Cell.Offset(0, -5).Text
        Select Case LCase(Cell.Value)

    Case "title"
        wdRng.Paragraphs.Last.Style = .Styles("Title")

    Case "main"
        wdRng.Paragraphs.Last.Style = .Styles("Heading 2")

    Case "empty"
         wdRng.Paragraphs.Last.Range.Delete

    Case "pagebreak"
        wdRng.Paragraphs.Last.Range.InsertBreak Type:=7 'wdPageBreak

        Case "table6"
          ThisWorkbook.Sheets("Tables").Range("B817:C820").Copy
            With wdRng
            Set rngPara = .Paragraphs.Last.Range
            rngPara.Style = "Data"
            rngPara.PasteExcelTable False, False, False
            .Tables(.Tables.Count).Range.Paragraphs.Indent
            .Font.Hidden = 0
            '.Paragraphs.Last.Range.Delete
            Set rngPara = Nothing
            End With

        End Select
    Next Cell

        WordDoc.SaveAs2 Environ$("Temp") & "\" & _
                "Test" & ".docx"

    End With

    WordDoc.Close
    WordApp.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing

    Exit Sub

ErrorHandlerEndExecution:

    WordDoc.Close
    WordApp.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing

    'Application.ScreenUpdating = True
End Sub

Answer 1

之后：

Set wdRng = .Range.Characters.Last

插入：

wdRng.InsertAfter vbCr

更改：

wdRng.InsertAfter vbCr & Cell.Offset(0, -5).Text

收件人：

wdRng.InsertAfter Cell.Offset(0, -5).Text & vbCr

之后：

Next Cell

插入：

Do While wdRng.Characters.Last.Previous = vbCr
  wdRng.Characters.Last.Previous.Delete
Loop

Answer 2

使用以下代码代替我以前的回答中的代码，而不是创建另一个问题。

之后：

Next Cell

插入：

Dim t As Long
With WordDoc
  For t = 1 To .Tables.Count
    Set wdRng = .Tables(t).Range.Characters.Last.Next
    If wdRng.End < .Range.End Then
      If wdRng.Text = vbCr Then wdRng.Delete
    End If
  Next
End With

将表格从Excel粘贴到Word后删除多余的段落

2 个答案: