Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 364
  • Last Modified:

VBA Microsoft Word Find the Heading 1 immediately before each table

Screenshot of Microsoft Word document
http://www.screencast.com/t/nX1J5m85XFuY


Dim tablecount, glkey
tablecount = 0

tablecount = ActiveDocument.Tables.Count

For t = 1 To tablecount

glkey = Find the Heading 1 content immediately before each table
'something like: ActiveDocument.Tables(t).closest("Heading 1")

'I am using glkey here to pass on to a REST call for each table
 
   
Next
0
maxdbase
Asked:
maxdbase
  • 2
1 Solution
 
xtermieCommented:
If I understand your issue....here is a function that will get you the level of a heading
that would help you in your task above

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

Open in new window

0
 
xtermieCommented:
You can call it from some other generic function that does something like:
Public Sub mysub3()
    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 = ActiveDocument
    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)))
     Next intItem
... ' anything else you wanna do
End Sub

Open in new window

0
 
maxdbaseAuthor Commented:
This is great, how do I get the closest Heading 1.
Sort of like jquery's closest function that steps outside of the table in the dom then
goes down and finds the first occurrence of a node.
0
 
GrahamSkanCommented:
This code finds each table and walks backwards until it finds a Heading 1 paragraph:
Sub FindHeadings()
Dim doc As Word.Document
Dim tbl As Word.Table
Dim rng As Word.Range
Dim para As Word.Paragraph

Set doc = ActiveDocument
For Each tbl In doc.Tables
    DoEvents
    Set rng = tbl.Range
    rng.Collapse wdCollapseStart
    rng.Move wdCharacter, -1
    rng.Expand wdParagraph
    Set para = rng.Paragraphs.Last
    Do Until para.Style = "Heading 1"
        DoEvents
        rng.Collapse wdCollapseStart
        rng.Move wdCharacter, -1
        rng.Expand wdParagraph
        Set para = rng.Paragraphs.Last
    Loop
    MsgBox para.Range.Text
Next tbl
End Sub

Open in new window

1

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now