vba - Vba在MS word中创建“目录”并将其复制到excel表
问题描述
我是 vba 的新手,并且对在 excel vba 中使用 word 较新。我正在寻找可以在 MS Word 中创建“目录”并将其复制到 Excel 表的代码。
到目前为止,我已经尝试过以下 -
Sub PrintHeadings()
Dim wrdApp As Word.Application
Dim wrdDoc As Document
Dim Para As Paragraph
Dim oldstart As Variant
Set wrdApp = CreateObject("Word.Application") 'open word
Set wrdDoc = wrdApp.Documents.Open("C:\Users\mishra19\Desktop\Documents\May 2018 Release\test.Docx", , True, False, , , , , , , , True) 'open file
wrdDoc.ActiveWindow.ActivePane.View.Type = wdPrintView 'avoids crashing if opens on read view
With wrdDoc.ActiveWindow.Selection
.GoTo What:=wdGoToHeading, which:=wdGoToFirst 'go to first heading
MsgBox "x"
Do
Set Para = .Tables(1) 'get first paragraph
Title = Replace(Para.Range.Text, Chr(13), "") 'gets title and remove trailing newline
Debug.Print Title, "pg. "; .Information(wdActiveEndAdjustedPageNumber) 'prints title and page to console
oldstart = .Start 'stores position
.GoTo What:=wdGoToHeading, which:=wdGoToNext 'go to next heading
If .Start <= oldstart Then Exit Do 'if looped around to first section (i.e. new heading is before old heading) we are done
Loop
End With
wrdDoc.Close
wrdApp.Quit
Set Para = Nothing
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub
解决方案
小调整:
Sub CopyHeadings()
Dim wrdApp As New Word.Application, wrdDoc As Word.Document, wrdRng As Word.Range, r As Long
With wrdApp
.Visible = False
Set wrdDoc = .Documents.Open("C:\Users\mishra19\Desktop\Documents\May 2018 Release\test.Docx", _
ReadOnly:=True, AddToRecentFiles:=False, Visible:=False) 'open file
With wrdDoc
Set wrdRng = .Range(0, 0)
'create a Table of Contents
.TablesOfContents.Add Range:=wrdRng, IncludePageNumbers:=True
'get the TOC entries
With wrdRng.Paragraphs(1).Range.Fields(1).Result
For r = 1 To .Paragraphs.Count
ActiveSheet.Range("A" & r).Value = Split(.Paragraphs(r).Range.Text, vbTab)(0)
ActiveSheet.Range("B" & r).Value = Split(.Paragraphs(r).Range.Text, vbTab)(1)
Next
End With
.Close False
End With
.Quit
End With
Set wrdRng = Nothing: Set wrdDoc = Nothing: Set wrdApp = Nothing
End Sub
推荐阅读
- swift - 标记格式是否仅适用于 Swift Playground?
- java - 验证购物车中可用的产品,然后使用删除链接 a 使用 selenium Java 删除。这里的产品数量未知
- azure-aks - 未能创建服务主体。您可以使用现有的服务主体或稍后再试
- java - 如何控制 Recyclerview 项目?
- python - 根据python中的给定条件最小化n的最快方法
- java - 如何修复 JTable 中的整数排序?
- javascript - 动态标题仅适用于 index.html
- mongodb - 自从切换到新的 go mongo 驱动程序后,map[string]interface{} 没有被正确解析
- vue.js - 如何根据从 vue-router 收到的参数渲染内容?
- c# - 通过 IP 地址与 C# 聊天程序。连接不同网络中的两台计算机