自动从 Excel 传输到 Word 中的制表符分隔列表

Question

我在 excel 中有一个 table，其中包含我想传输到 word 文档的数据。根据值所在的列，我试图将数据放入不同的选项卡顺序（例如：列表级别 1 是初始列表，列表级别 2 是在列表中按一次选项卡）。

我试图通过识别前一个 sheet 上的单元格来做到这一点，我目前使用的代码可以打开 word 文档，但为了真正引入数据，我不能似乎明白了。

我当前的代码如下所示（我在同一文件夹中有单词文档“Template.docx”：

Private Sub CreateList()

Dim WRD As Object, DOC As Object
On Error Resume Next
Set WRD = CreateObject("Word.Application")
If Err.Number <> 0 Then
    Set WRD = CreateObject("Word.Application")
End If
On Error GoTo 0

Set DOC = WRD.Documents.Open(ThisWorkbook.Path & 
"\Template.docx", ReadOnly:=True)

WRD.Visible = True

If Sheet1.Range("A1").Value = "Package 1" Then

    With DOC

    ' INSERT DATA FROM EXCEL INTO A TAB DELIMITED LIST

    End With

End If

Set WRD = Nothing
Set DOC = Nothing

End Sub

Answer 1

您在 Word 中引用了一个 tab-delimited 列表，但您的图片描述了通常在 Word 中作为段落标题处理的内容。

假设您确实需要标题，并且您的 Word 文档正确使用了具有 multi-level list-numbering 的 Word 标题样式，您可以使用类似：

Sub CreateList()
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim xlSht As Worksheet, sPath As String, LRow As Long, LCol As Long, r As Long, c As Long
sPath = ActiveWorkbook.Path: Set xlSht = ActiveSheet
With xlSht.Cells.SpecialCells(xlCellTypeLastCell)
  LRow = .Row: LCol = .Column: If LCol > 9 Then LCol = 9
End With
With wdApp
  .Visible = False
  Set wdDoc = .Documents.Open(Filename:=sPath & "\Template.docx", AddToRecentFiles:=False, ReadOnly:=True, Visible:=True)
  With wdDoc
    For r = 2 To LRow
      For c = 1 To LCol
        If xlSht.Cells(r, c).Value <> "-" Then
          .Characters.Last.InsertBefore xlSht.Cells(r, c).Value & vbCr & vbCr
          .Characters.Last.Previous.Previous.Style = "Heading " & c
        End If
      Next
    Next
  End With
  .Visible = True
End With
Set wdDoc = Nothing: Set wdApp = Nothing: Set xlSht = Nothing
End Sub

如果您习惯于使用 list-level 编号，您可以替换为：

        If xlSht.Cells(r, c).Value <> "-" Then
          ...
        End If

代码块类似：

        If xlSht.Cells(r, c).Value <> "-" Then
          .Characters.Last.InsertBefore xlSht.Cells(r, c).Value & vbCr & vbCr
          With .Paragraphs(.Paragraphs.Count - 2).Range.ListFormat
             .ApplyListTemplateWithLevel ListTemplate:=ListGalleries(wdOutlineNumberGallery).ListTemplates(2), _
                ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:=wdWord9ListBehavior
             .ListLevelNumber = c
          End With
        End If

并插入：

    For c = 1 To LCol ' or 9 for all possible levels
      .ListTemplates(2).ListLevels(c).TextPosition = InchesToPoints(c * 0.5 - 0.5)
      .ListTemplates(2).ListLevels(c).ResetOnHigher = True
    Next

在现有决赛 'Next' 之后。

如果以上没有提供您想要的列表编号格式，您将需要选择合适的 ListGallery（来自 wdBulletGallery、wdNumberGallery 或 wdOutlineNumberGallery）以及 ListTemplate 编号。

自动从 Excel 传输到 Word 中的制表符分隔列表

Automatically Transfer from Excel to a Tab Delimited List in Word

excel

vba

ms-word