Solved

VBA Microsoft Word Find the Heading 1 immediately before each table

Posted on 2016-08-22
4
41 Views
Last Modified: 2016-08-22
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
Comment
Question by:maxdbase
  • 2
4 Comments
 
LVL 17

Expert Comment

by:xtermie
ID: 41765466
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
 
LVL 17

Accepted Solution

by:
xtermie earned 500 total points
ID: 41765470
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
 

Author Comment

by:maxdbase
ID: 41765509
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
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 41765916
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

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

The Selection object is designed for user interaction. It has a Range property, so it can be used in most places that a Range object can. Recorded macros must use the Selection because they are simply copying what the user is doing. A Range propeā€¦
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
This video shows the viewer how to set up and create Footnotes in their document. Click on the References tab: Select "Insert Footnote": Type in desired text:
The viewer will learn how to make their project stand out over others by learning how to change colors and shapes, add spaces, change directions, and add bullets to their charts.

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now