Get Heading Number and Text from current selection - vba

I am looking for a function that returns the number and text of the currently last heading in a text, based on the current selection.
I want a function to return "1.1. Felines" from
1. Animals
Animals are sometimes domesticated.
1.1. Felines
Felines are *often* cats.
1.2. Canines
Canines are sometimes dogs.
where "often" ist my current selection. My current selection may (and will) be inside a table in my final application, so the function has to work inside tables, too.
The headings are the standard format templates "Heading 1" or "Heading 2" or "Heading 3" that are present in every empty Word file.
The function should return the lowest level heading that is the last heading above the selection. Bonus points for a second function that returns the previous "level 1 Heading".
I have found this: this and other SO questions, but I am not deep enough into VBA to modify them to do what I want. I also googled into the Selection.Information and Selection.Style but hit a wall with both. For example wdActiveEndSectionNumber from .Information only returns the section number, but I do not use a new section for each heading. With the .Style I did not manage to find the last Heading before the selection.

Related

Cross reference to custom reference type

I'm trying to add a cross reference into a SEQ field.
My document contains "point headings" which means that between two heading elements, the user can add an extension (between 1.1 and 1.2 may be 1.1A, 1.1B, ...)
Here is how the point heading code looks like:
{STYLEREF "HEADING 2" \N}{SEQ "HEADING 2 POINT" \* ALPHABETIC \S 2}
Which results with: 1.1A
I want to be able to do a cross reference into the point heading.
While I can set the reference type into 'Heading' I can't find out how to reference it to a custom element.
Searching through the web did not reveal any solution but some clues that it might be possible:
This website which explains cross-reference formatting, contains an image with custom type (My New Caption).
Microsoft DOC's description for ReferenceType is: The type of item for which a cross-reference is to be inserted. Can be any WdReferenceType or WdCaptionLabelID constant or a user defined caption label.
My client is used to work with the cross reference dialog box hence I prefer this approach, but VBA script will also be appreciated.
Thanks!
Update:
I'll try to describe my constraints and environment.
Headings 1-9 are used inside Multi-Level list item, hence they have custom styling.
They cannot be changed.
For a specific task, which is described and answered here, I've created what I call 'Point Headings'.
'Point Headings' are basically an extension that the user can add in between the Multi-Level numbering with a VBA macro.
Let's say that I have two Heading 2 items (1.1, 1.2), the user can add 1.1A, followed by 1.1B and so on.
The user can add point headings from level 2 up to level 5.
Their style is 'Heading 2 Point', 'Heading 3 Point' and so on, and each one is based on its relevant Heading.
As described above, eventually in the document, the word field has the following structure: {STYLEREF "HEADING 2" \N}{SEQ "HEADING 2 POINT" \* ALPHABETIC \S 2}.
My goal is to be able to cross reference into these items, but they do not appear in the Heading type, well because they are not of style Heading.
I wish to be able to create a custom reference type, which will show these items.
After some research, here is my answer. Hopefully it will help some future viewers.
Private Sub createPointHeader(pointLevel As Integer, Optional appendixPrefix As String = "")
Dim sQuote As String, referencedStyle As String, captionName As String
sQuote = Chr(34)
referencedStyle = appendixPrefix & "Heading " & pointLevel
captionName = referencedStyle & " Point"
With Selection
.Fields.Add .Range, wdFieldEmpty, "StyleRef " & sQuote & referencedStyle & sQuote & " \n", False
.Collapse wdCollapseEnd
CaptionLabels.Add (captionName)
.InsertCaption Label:=captionName, ExcludeLabel:=True
' Select the created field
.MoveLeft Count:=1, Extend:=True
' Replace the syntax from Arabic to Alphabetic
.Fields.ToggleShowCodes
With .find
.Text = "ARABIC"
.Forward = False
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.Range.Text = "ALPHABETIC \s " & pointLevel
End If
End With
.Fields.ToggleShowCodes
.Fields.Update
.MoveRight Count:=1
.InsertAfter vbTab
.Collapse wdCollapseEnd
' Apply style after .InsertCaption, because it changes the style to Caption
.Style = ActiveDocument.Styles(referencedStyle & " Point")
End With
End Sub
Few remarks
I have two styles to base upon: Heading (2-5), and Appendix Heading (2-5). This is the reason for the optional appendixPrefix as a sub variable.
CaptionLabels.Add as I've checked can get the same value. No need to check in advance if it already exists.
Selection.InsertCaption automatically changes the style into Caption. This is why I apply the style change at the end.
The result
Here is how Point Heading 2 looks like:
{STYLEREF "HEADING 2" \N"}{SEQ HEADING_2_POINT \* ALPHABETIC \S 2}
Snapshot of the document with the point headings
And finally, as requested, cross reference to the Point headings from the Cross reference box
The question asks how to create a cross reference to a custom reference type. I suspect this answer may actually respond to what the original asker might have been getting at.
The idea is to use custom caption labels. A custom caption label appears (ideally) in the Insert/Cross Reference dialog.
A custom caption label is created when you say Insert/Caption and then ask to add a new custom label.
If you have added a custom caption label yourself in a given document, then it automatically appears as a choice when you say Insert/Cross Reference ...
However a difficulty arises when you are given a document where someone else has already added the cross reference type and you want to edit it (by adding additional cross references to the given type of caption). The secret here is to add the custom caption label yourself (even though it already exists), by creating a new temporary caption with the custom label type. You can then go ahead and delete the temporary caption, but you will from then on be able to add cross references to that caption type.
I use this when I want to make reference to 'Code Snippets' or 'Boxes' or 'Algorithms'.
I'm taking the chance of responding as an answer rather than as a comment as the reply is longish but hopefully should get you going in the right direction.
I think you have been led down the wrong path by the point pages article you have referenced.
I'm assuming that we can't modify the styles 'Heading 1' to 'Heading 9'. If you can then you will be able to adapt the suggestion below to use with only 'Heading 1' to 'Heading 9' styles.
You will need to create some new styles. I've used the following styles
Name Based on Style Outline level
Heading Point 1 Heading 1 1
Heading Point 2 Heading 2 2
Heading Point 2 Ext Heading 2 3
Heading Point 3 Heading 3 4
Heading Point 3 Ext Heading 3 5
Heading Point 4 Heading 4 6
Heading Point 4 Ext Heading 4 7
Heading Point 5 Heading 5 8
Heading Point 5 Ext Heading 5 9
Please note that getting the outline level correct is important for Heading numbering.
Next create a new Multilevel list. Call the list 'PointNumbering' (Because if you do this you can identify the list by the name in VBA should you need this facility). Link the styles 'Heading Point 1' to 'Heading Point 5 Ext' to levels 1 to 9 of the numbering sequence (e.g. Outline level 1 matches level 1 in the numbering sequence etc).
Turn off the legal style numbering for each level otherwise we won't be able to use Alphabetic numbering. Set the numbering scheme as indicated below.
Level Number style format levels* Final Appearance
1 1,2,3, 1 1
2 1,2,3 1.2 1.1
3 A,B,C 1.23 1.1A
4 1,2,3 1.2.4 1.1.1
5 A,B,C 1.2.45 1.1.1A
6 1,2,3 1.2.4.6 1.1.1.1
7 A,B,C 1.2.4.67 1.1.1.1A
8 1,2,3 1.2.4.6.8 1.1.1.1.1
9 A,B,C 1.2.3.6.89 1.1.1.1.1A
The actual levels are picked from a drop down list and appear as '1' in the number format box. This makes getting the numbering wrong quite easy so take care. The last number in each level is obtained by selecting the number format in the 'Number style for this level' box.
Once you have set up your styles and ensured that they are linked to the above numbering scheme you need to adjust the styles used for the headings in you current document.
Do a search and replace to do the following style replacements
Current Style New Style
Heading 1 Heading Point 1
Heading 2 Heading Point 2
Heading 3 Heading Point 3
Heading 4 Heading Point 4
Heading 5 Heading Point 5
Then for each of your extension headings where you are currently creating the numbering using style ref and seq field delete the fields and apply the relevant Ext Heading.
Thus for A,B,C numbering after 'Heading Point 2', apply the 'Heading Point 2 Ext' style.
This should now mean that all Heading Point styles can be accessed through the cross reference dialog.
If you document headings at 'Heading 6' Level 6 and below the after 'Heading Point 5 Ext you can use the Heading styles (Heading 6 to Heading 9) as normal. However, each time you use a Heading 6 you will need to manually reset the number. I think this is an easier task than asking users to insert multiple styleref and seq fields because you just select then right click on the heading number and then tick buttons to enable 'Advanced value (skip number)' which allows you to reset any level within your current Heading Number.
If you subsequently need to create a TOC field for your document you will now have to use the \t switch and provide a list of styles and the level number to use for the style in the TOC. e.g. {toc \t "Heading Point 1,1,Heading Point 2,2,Heading Point 2 Ext,2,Heading Point 3,3,Heading Point 3 Ext,3.....etc}.
I have created and tested all of the above in a Word document.

VBA to copy text from excel to on specific location in wordfile

Problem: Pasting copied data from excel to specific location in a word file.
Currently I have code which can paste the value, but it does so to "paragraph1"
myDoc.Paragraphs(1).Range.Paste
How do I specify the exact location (by line) in which to paste the data?
Let me know if more info is required.
Thanks!
Mohd Akhtar
Word gives a number to each character in the document's body, from 1 up. It then defines a range with Range.Start to Range.End So, Paragraphs(1).Range might be equal to Range(Start:=1, End:=120).
The text contained in that range is Range.Text, Read/Write. Therefore, Paragraphs(1).Range.Text = "My new paragraph text" will replace the existing text in the document's first paragraph. ActiveDocument.Range(0, 0).Text specifies the range before the first character in the document.
In order to insert text at a specific location you have to find the location, meaning the Range. As you have seen above, if the range has a length of 0 you can insert before or between existing text, and if it has any length the new text will replace whatever was there before. New and old text need not have the same length.
Counting paragraphs is helpful to find a range. You can also count words or sentences. You can search for a specific word combination. Or you can use a bookmark. In all of these cases you define a range the text of which you can replace outright, or which you can use to find a location relative to it where to insert the text, such as the beginning or end or after the 3rd word or whatever.
You could also use some bookmarks:
You can choose where you put your bookmark and then write on it like this
ThisDocument.Bookmarks("NAME_OF_THE_BOOKMARK").Range.Text = THE_EXCEL_DATA
To place a bookmark you have to click on the selected area and then go on Insert->Bookmarks and then name it.

Word VBA: How to get the current section number

I'm building a macro that loops through each word of a document and checks via a regex whether it matches a pattern and if so, writes the found word to an excel sheet. It goes like this:
For Each sentence In ActiveDocument.StoryRanges
For Each w In sentence.Words
myWord = w
If TestRegExp(myPattern, myWord) Then
WKS.Cells(myCount, 1).Value = myWord
myCount = myCount + 1
End If
Next
Next
This part works fine. Now I would also like to get the section per found word (aka "in what section did the found word appear"). I found the command "selection.Information" but no matter what I try, I only get "Section = 1". Even if I just check the whole document for sections ("ActiveDocument.Sections.Count") I only get 1. So there must be something off with the sections, but this document definitely has sections. Has anybody an idea what I do wrong?
Page and section numbers in Word are difficult since the document's logical structure may not match the displayed text. I can, for example, reset page numbering in the middle of a document.
Similarly, a "section" to word is the separation of parts of the document by virtue of the insertion of a section break, whether next page, continuous, next odd, next even, etc. However, the reader often thinks of the "section" as the number that appears before a "heading 1" style paragraph. Again, I can reset those numbers mid-document. So, a document that has 3 sections (logical) might have only two headings: none in section 1, one in section 2 that says "1. Introduction", and another in section 3 that says "Appendix A. Glossary". The (logical) sections are still 1, 2, 3......
w = ActiveDocument.Sentences(10).Words(1) ' given some word in the document
MsgBox w.Information(wdActiveEndPageNumber) ' logical page number
MsgBox w.Information(wdActiveEndAdjustedPageNumber) ' displayed page number
MsgBox w.Information(wdActiveEndSectionNumber) ' logical section number
As for the displayed section number, which is there by virtue of being "Heading 1" style and that style having been set to a multi-level numbered format... getting the displayed number of that list item appears to be very difficult, in the general case.
Solutions I've seen involve searching for the previous paragraph that matches a heading style then getting the .ListFormat.ListString from that.
MsgBox w.GoTo(What:=wdGoToHeading, Which:=wdGoToPrevious).ListFormat.ListString
but that gets the previous heading of any level, not just "Heading 1".
Sections are different from StoryRanges, and are part of the StoryRanges(wdMainTextStory) range. You can use For loop instead of For Each loop to get the WdStoryType number:
For i = 1 To ActiveDocument.StoryRanges.Count ' or 1 To 17
For Each w In ActiveDocument.StoryRanges(i).Words
If TestRegExp(myPattern, w) Then
WKS.Cells(myCount, 1).Value = myWord
myCount = myCount + 1
Debug.Print i, myCount, w ' i has the WdStoryType number
End If
Next
Next
Also, RegExp is probably not needed, as Word has wildcard Find and Replace https://superuser.com/questions/86397/wildcards-in-word, and VBA has the Like Operator

VBA getcrossreferenceitems(wdRefTypeNumberedItem) Paragraph Cut Off?

I'm using excel vba to extract information from a word document.
In the word document, there are levels of numbered lists. For example:
1. ABC
1.1 DEF
1.1.1 ABCDEF
2. AAA
2.1 BBB
2.1.1. CCC
and I need to get the full context of each heading in each level and put them into an excel range, i.e. {"1.ABC", "1.1 DEF", "1.1.1 ABCDEF", "2. AAA", "2.1 BBB", "2.1.1. CCC"}
The function I use is:
For Each sec In objDoc.getcrossreferenceitems(wdRefTypeNumberedItem)
However, my headings are truncated if the headings are too long. For example, I have (random text is added for confidentiality reasons):
"5.2.11. Current References: As part of the evaluation process, XXX will conduct 2340AERTQ3493YR. When selecting ADT34534FDGSR, please ensure that they are AERA34AEFDS."
But only
5.2.11. Current References: As part of the evaluation process, XXX will conduct 234
is displayed, and the rest of the sentence is gone.
If anybody has an alternate solution, please let me know.
i confirm this behavior. A workeable albeit and elaborate solution is to scan the document for all numbered items which gives you the full text and then cross reference that result against the list returned by the GetCrossReferenceItems. There's quite some work involved but works and gives you the ability to create one list with referable Headings and NumberedItems, which is what I did to build a more user friendly alternative to Word's own implementation.
You'll have to match the formatting Word applies to the list returned by GetCrossReferenceItems, ie. the identation and removal of special characters.
Be careful with track changes. There is a bug in GetCrossReferenceItems which means that items (in my case headers) that have a tracked change at the beginning of the text are not returned by GetCrossReferenceItems but internally are still on the list so the index is offset. If the item in question is item 11, then GetCrossReferenceItems gives the item belonging to item 12 the item 11. A workaround is to accept all revisions before GetCrossReferenceItems and undo it after.
It's not easy but works.
I met a similar problem in MSWord. I found some paragraph's text are shorten in the following code
Sub bug()
items = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem)
For idx = 1 To UBound(items)
MsgBox items(idx)
Next
End Sub
I have to use a some long solution( in Python, sorry. But is is easy to rewrite in VBA):
varHeadings = []
for par in objDoc.Paragraph:
if par.Range.ListFormat.ListType == win32com.client.constants.wdListOutlineNumbering:
idx = par.Range.ListFormat.ListString
txt = par.Range.Text.strip('\n').strip('\r')
varHeadings.append('%s%s' % (idx, par.Range.Text))
which does work. However, as I have said, it is some tedious. So did I miss some VBA function in MSWord, or GetCrossReferenceItems has known bug and can not found any replacement in VBA?

VBA for changing font and colour of a cell if a certain word is typed in it

I have a somewhat large spreadsheet with a type of summary page that follows a calender layout.
On this page I manually change the font and color of cells to make it easy for me to find certain things on it. For example, (I lecture mathematics) if I have revision on a certain lesson, I make that cell bold and green. (exact type of green I can sort out myself). I want a VBA code if possible so that if I type the word revision into a cell on that sheet only, not whole workbook, that it would automatically change it to green.
Realistically, I don't manually type in the word revision always. Some of it uses lookups of various types to find what happens on that day to display a word (for example revision) in that given cell.
I don't know if this is possible to do. I realize that if "revision" is shown due to a lookup then the contents of that cell is not equal to "revision" but a formula which simply displays "revision"
Any assistance would be appreciated. If I have a basic code I can manipulate to get it right.
Thanks
Maybe you're looking for something along the lines of:
Sub CheckRevision()
Dim CurCell As Object
For Each CurCell In ActiveWorkbook.ActiveSheet.Range("A1:AZ500")
If CurCell.Value = "Revision" Then CurCell.Interior.Color = RGB(0,204,0)
Next
End Sub
Or equivalently, you can probably use conditional formatting. Home Tab > Conditional Formatting > Highlight Cells Rules > Text that Contains. From there, type the value "Revision" into the value box and you can change the format of the cell to how you like it.