时间戳

首页 > 解决方案 > 自动从 Excel 传输到 Word 中的制表符分隔列表

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

问题描述

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

我试图通过识别前一张纸上的一个单元格来做到这一点，到目前为止我的代码可以打开 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

标签： excelvbams-word

解决方案

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

假设您确实需要标题并且您的 Word 文档正确使用了具有多级列表编号的 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

如果您热衷于使用列表级编号，则可以替换：

        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

在现有的最终“下一个”之后。

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

推荐阅读