Vba 在MS Word中,查找文档中表格所在的标题
以下是VBA问题: 我有一个Word文档,其中有几个章节(“标题1”)。在章节的开头,有一个表格,里面有我想要处理的信息。 很容易通过文档的“表”集合循环提取表中的信息 但是,如何才能获得这些表格中的信息,即“章节名称”(“标题1”) 我需要一种方法来找到从“表”-集合中的表到周围章节名称(“标题1”)的“链接”。因此,使用集合中的“表”-Objekt的信息查找章节名称(“标题1”)(文件表(1)->“3.章节标题第3章”) 我的想法是从表的位置向后搜索,直到找到样式为“标题1”的范围。但是我如何获得职位信息呢Vba 在MS Word中,查找文档中表格所在的标题,vba,ms-word,Vba,Ms Word,以下是VBA问题: 我有一个Word文档,其中有几个章节(“标题1”)。在章节的开头,有一个表格,里面有我想要处理的信息。 很容易通过文档的“表”集合循环提取表中的信息 但是,如何才能获得这些表格中的信息,即“章节名称”(“标题1”) 我需要一种方法来找到从“表”-集合中的表到周围章节名称(“标题1”)的“链接”。因此,使用集合中的“表”-Objekt的信息查找章节名称(“标题1”)(文件表(1)->“3.章节标题第3章”) 我的想法是从表的位置向后搜索,直到找到样式为“标题1”的范围。但是我如
Public Sub ImportRequirementsFromWordTables()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRowWord As Long 'row index in Word
Dim iRowExcel As Long
Dim iColWord As Integer 'column index in Excel
Dim tbl As Variant
Dim strCurrCell As String
wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
'Set Titles in Excel
Cells(1, 1) = "Anf.-ID"
Cells(1, 2) = "Referenz"
Cells(1, 3) = "Anforderungstitel"
Cells(1, 4) = "System"
Cells(1, 5) = "Art"
Cells(1, 6) = "Priorität"
Cells(1, 7) = "Beschreibung (optional)"
With wdDoc
TableNo = wdDoc.Tables.Count
For Each tbl In wdDoc.Tables
'Check if it is a table with Reqs
If Left$(tbl.Cell(1, 1).Range.Text, 7) = "Anf.-ID" Then
'copy cell contents from Word table cells to Excel cells
With tbl
'Find Chapter Name of chapter table lies in in Word and write to Excel
'????
iRowWord = 2
iRowExcel = 2
While iRowWord < .Rows.Count
For iColWord = 1 To .Columns.Count
strCurrCell = .Cell(iRowWord, iColWord).Range.Text
Cells(iRowExcel, iColWord) = Mid$(strCurrCell, 1, Len(strCurrCell) - 1)
Next iColWord
'Fill Description
strCurrCell = strReplaceSpecialCharacters(.Cell(iRowWord + 1, 3).Range.Text)
Cells(iRowExcel, 7) = Mid$(strCurrCell, 1, Len(strCurrCell) - 1)
'Skip to next relevant in Word aka skip one
iRowWord = iRowWord + 2
'Skip to next in Excel
iRowExcel = iRowExcel + 1
Wend
End With
End If
Next
End With
Set wdDoc = Nothing
End Sub
感谢您提供的任何想法您可以使用 Selection.goToNext wdGoToHeading Selection.goToNext wdGoToTable 这样你就可以记住哪个表格在哪个标题后面。
如果您需要更详细的代码示例,请询问,我会提供给您。请显示您已经拥有的代码,或者先尝试自己解决这个问题,然后编辑您的问题,将您遇到的代码部分包括在内。看看这是否能让您开始。能给我拿个样品吗?
Private Sub getHeading(wdSource As Document)
Dim docSource As Word.Document
Dim rng As Word.Range
Dim astrHeadings As Variant
Dim strText As String
Dim intLevel As Integer
Dim intItem As Integer
Set docSource = wdSource
' Content returns only the
' main body of the document, not
' the headers and footer.
astrHeadings = _
docSource.GetCrossReferenceItems(wdRefTypeHeading)
For intItem = LBound(astrHeadings) To UBound(astrHeadings)
' Get the text and the level.
strText = Trim$(astrHeadings(intItem))
intLevel = GetLevel(CStr(astrHeadings(intItem)))
Debug.Print intLevel & " " & strText
Next intItem
End Sub
Private Function GetLevel(strItem As String) As Integer
' Return the heading level of a header from the
' array returned by Word.
' The number of leading spaces indicates the
' outline level (2 spaces per level: H1 has
' 0 spaces, H2 has 2 spaces, H3 has 4 spaces.
Dim strTemp As String
Dim strOriginal As String
Dim intDiff As Integer
' Get rid of all trailing spaces.
strOriginal = RTrim$(strItem)
' Trim leading spaces, and then compare with
' the original.
strTemp = LTrim$(strOriginal)
' Subtract to find the number of
' leading spaces in the original string.
intDiff = Len(strOriginal) - Len(strTemp)
GetLevel = (intDiff / 2) + 1
End Function