I use the Web Layout View with collapsible Headings.
How to expand all headings but keep normal Text collapsed ?
this VBA Code processes 1k words in 1second .
But on longer documents ( 100k words) it just freezes.
Sub outline_doc2()
ActiveDocument.ActiveWindow.View.CollapseAllHeadings
Dim para As Paragraph
For Each para In ActiveDocument.Paragraphs
' if heading is NOT normal Text , expand...
If para.OutlineLevel <> wdOutlineLevelBodyText Then
para.CollapsedState = False
'... but if next paragraph is normal text , then do not expand
If para.Next.OutlineLevel = wdOutlineLevelBodyText Then
para.CollapsedState = True
End If
End If
Next
End Sub
These changes are sensitive to the UI, so I'd recommend setting up the ScreenUpdating property while you are doing some work on the Word document:
Application.ScreenUpdating = False
' some work here
Application.ScreenUpdating = True
Currently using a workaround method :
manually indicate Headings to Expand with a "+" prefix
Letting an external Script iterate over the Headings and send Expand command it it matches the "+" Prefix
On a Document of 50k words , my updated VBA Script still produced no results after 4 minutes so I terminated the process.
The External Script had the Document outlined after 1:30 minutes.
App i use for this : strokesplus
Related
I have a hyperlink (for example www.google.com) that is highlighted, possibly with different colors.
I would like to determine the highlight color of each character in the hyperlink.
I used:
r.Hyperlinks(i).Range.Characters(j).HighlightColorIndex
For the very first (j=1) character of the hyperlink (which is w in this case) I get HighlightColorIndex=9999999, regardless of the highlight color. For all the remaining characters (ww.google.com) the code works.
I also tried r.Hyperlinks(i).Range.Characters.First.HighlightColorIndex, but for j=1 it returns 9999999 as well.
How could I get the value of the highlight color of the first character in the hyperlink?
The problem is that the first character of the Range sits "between" when you query it in this manner. One way to see that is
Display the Styles pane (in the Home tab, click on the dialog launcher of the "Styles" group)
Click in the hyperlink around the third character and look at the style name
Use Left Arrow until the insertion point (cursor) is just to the left of the first character in the hyperlink
When I do that I see the style name switch from "Hyperlink" to "Normal" - IOW Word is looking at what is in effect up to that point, and not at what follows. (I was surprised!). If I then hold Shift and press Right Arrow, I see the Hyperlink style selected, as I'd expect.
With Hyperlinks, the fact that these are field codes makes working with the first and last characters tricky, because "selecting" them in code picks up the entire field - that's why you're getting 999999 (= undefined - more than one color).
I could find only one way to work around this: using SendKeys to select the first and last characters as a user does (Shift+Right arrow). I don't like it; it's not going to be very reliable, I fear. The code will not work correctly if you run it from the VBA Editor - it must be run from the document interface where SendKeys should be executed (button in the QAT, for example). The following worked for me:
Sub HyperlinkHighlight()
Dim R As word.Range, c As word.Range
Dim doc As word.Document
Dim f As word.Field
Dim i As Long, j As Long
Set doc = ActiveDocument
Set R = doc.content
For i = 1 To R.Hyperlinks.Count
R.Hyperlinks(i).Range.Characters(1).Select
Selection.Collapse wdCollapseStart
SendKeys "+({Right})", True
DoEvents
Debug.Print Selection.Range.HighlightColorIndex
For j = 2 To R.Hyperlinks(1).Range.Characters.Count - 1
Debug.Print R.Hyperlinks(i).Range.Characters(j).HighlightColorIndex
Next j
R.Hyperlinks(i).Range.Characters(R.Hyperlinks(i).Range.Characters.Count - 1).Select
Selection.Collapse wdCollapseEnd
SendKeys "+({Right})", True
DoEvents
Debug.Print Selection.Range.HighlightColorIndex
Next i
End Sub
I need to dynamically generate word documents using text from an Access database table. The caveat here is that some of the text coming from the database will need to be modified into MergeFields. I am currently using Interop.Word (VBA Macro) and VB.NET to generate the document.
My steps so far look like this:
Pull standard .docx Template
Fill In template with pre-defined filler text from table
Add MergeFields by replacing pieces of the filler text with actual mergefields
Attach Datasource and execute Mail Merge
After testing, I noticed that I cannot simply store MergeFields into the access database as a string, they do not feed over into the actual document. What I am thinking then is creating a table of known strings that should be replaced with MergeFields by the coding.
For Example:
Step 2 will insert "After #INACTIVE_DATE# your account will no longer be active." which will be in the database text.
Step 3 will find/replace #INACTIVE_DATE# with a MergeField «INACTIVE_DATE». I am using Word Interop to do this, so theoretically I can loop through the document.
I wasnt able to do a "Find And Replace" from text to MergeField, so how should I go about implementing this?
Tagging VBA additionally as I am seeking a "VBA" style answer (Word Interop).
You've left out quite a lot of detail, so I'll go about answering this in somewhat general terms.
What you want to do is definitely achievable. Two possible solutions immediately come to mind:
Replacing ranges using Find
Inserting tokens using TypeText
Replacing ranges using Find
Assuming the text has already been inserted, you can search the document for the given pattern and replace it with a merge field. For instance:
Sub FindInsertMerge()
Dim rng As Range
Set rng = ActiveDocument.Range
With rng.Find
.Text = "(\#*\#)"
.MatchWildcards = True
.Execute
If .Found Then
ActiveDocument.MailMerge.Fields.Add rng, Mid(rng.Text, 2, Len(rng.Text) - 2)
End If
End With
End Sub
Will find the first occurence of text starting with #, matches any string and ends with #. The contents of the found range will then be replaced by a merge field. The code above can easily be extended to loop for all fields.
Inserting tokens using TypeText
While I would normally advice against using Selection to insert data, this solution makes things simple. Say you have a target range, rng, you tokenize the database text to be inserted, select the range, start typing and whenever a designated mail merge field is found, insert a field instead of the text.
For instance:
Private Sub InsertMergeText(rng As Range, txt As String)
Dim i As Integer
Dim t As String
Dim tokens() As String
tokens = Split(txt, " ")
rng.Select
For i = 0 To UBound(tokens)
t = tokens(i)
If Left(t, 1) = "#" And Right(t, 1) = "#" Then
'Insert field if it's a mail merge label.
ActiveDocument.MailMerge.Fields.Add Selection.Range, Mid(t, 2, Len(t) - 2)
Else
'Simply insert text.
Selection.TypeText t
End If
'Insert the whitespace we replaced earlier.
If i < UBound(tokens) Then Selection.TypeText " "
Next
End Sub
Call example:
InsertMergeText Selection.Range, "After #INACTIVE_DATE# your account will no longer be active which will be in the database text."
I am working my way through two books (Roman's Writing Word Macros, Mansfield's Mastering VBA for MS Office). In my work environment, I use both Word 2007 and Word 2010.
My issue is that I want to use VBA to insert a very brief amount of standardized text before the English-language string in my numbered hierarchical headings. For instance, I have:
1.1.1 The Quick Brown Fox.
What I want is:
1.1.1 (XXxx) The Quick Brown Fox.
I guess my most basic issue is that I don't know how to approach the situation. I have hierarchical headings yet I don't know how to say, in effect, "Go to each hierarchical heading regardless of level. Insert yourself in front of the first English language word of the heading. Paste the text "XXxx" in front of the first word in the heading. Go on to the next heading and all remaining headings and do the same. My document is over 700 pages and has hundreds of hierarchical headings.
I see that paragraphs are objects and that hierarchical headings are paragraphs. However, I can't see any way to make VBA recognize what I am talking about. I haven't been able to use Selection approaches successfully. I've tried using the Range approach but just have not been able to phrase the VBA code intelligently. I haven't been able to specify a range that includes all and only the hierarchical headings and, especially, I don't understand how to get the insertion to happen in front of the first English-language word of the heading.
I have just begun to look at using Bookmarks. However, don't bookmarks require me to go to every heading and enter them? I may as well just paste my content if that is the case. I'm stumped. It is interesting that in no way, as might have been expected, does this appear to be a simple matter
Assuming you are using Word's outline levels (I think this is what you mean by hierarchical headings), you can check a paragraph for this state. For example, assuming I have a paragraph in my document that has the Heading 1 style applied to it:
Sub PrintHeadings()
Dim objDoc as Document
Dim objPara as Paragraph
Set objDoc = ActiveDocument
For each objPara in objDoc.Content.Paragraphs
If objPara.OutlineLevel <> wdOutlineLevelBodyText then
Debug.Print objPara.Range.Text
End If
Next objPara
End Sub
This code would print the contents of any paragraph that has an outline level above body text to the VBA Immediate Window. There are other approaches as well; you could use Find and Replace to search for each of the Outline Levels. This gives you a bit less control; you'd want your change to be something that could be encapsulated in a Word Find and Replace. But, it would be faster if you have a long document and not too many heading levels. A basic example:
Sub UnderlineHeadings()
Dim objDoc as Document
Set objDoc = ActiveDocument
With objDoc.Content.Find
.ClearFormatting
.ParagraphFormat.OutlineLevel = wdOutlineLevel1
With .Replacement
.ClearFormatting
.Font.Underline = wdUnderlineSingle
End With
.Execute Forward:=True, Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceAll
End With
End Sub
That would underline all of your text of Outline Level 1.
Perhaps that will get you started.
I asked this question some months ago: "My issue is that I want to use VBA to insert a very brief amount of standardized text before the English-language string in my numbered hierarchical headings." By "numbered hierarchical headings" I meant Word multilevel lists. The answers I received were appreciated but did not respond effectively to my question or guide me to a resolution. I pass this along in the hope it may be of use to others.
First, the "number" part of the Word heading is irrelevant. In writing your code, there is NO need to think of a "number" portion and a "text" portion of the heading. I was afraid that any text I was trying to insert would be inserted BEFORE the multilevel numbering rather than BEFORE the English language text. The multilevel numbering is apparently automatically ignored. Below are two solutions that worked.
This first macro succeeded in producing the desired result: 1.1.1 (FOUO). I used this macro to create individual macros for each order of heading. I haven't learned how to combine them all into one macro. But they work individually (but not without the flaw of taking too much time ~5 to 10 minutes for a complex, paragraph-heavy 670 page document).
Public Sub InsertFOUOH1()
Dim doc As Document
Dim para As Paragraph
Dim paraNext As Paragraph
Dim MyText As String
Dim H1 As HeadingStyle
Set doc = ActiveDocument
Set para = doc.Paragraphs.First
Do While Not para Is Nothing
Set paraNext = para.Next
MyText = "(U//FOUO) "
If para.Style = doc.Styles(wdStyleHeading1) Then
para.Range.InsertBefore (MyText)
End If
Set para = paraNext
Loop
End Sub
THIS WORKS ON ALL FIRST ORDER HEADINGS (1, 2, 3 ETC.)
I used the macro below to add my security marking all body paragraphs:
Public Sub InsertFOUObody()
'Inserts U//FOUO before all body paragraphs
Dim doc As Document
Dim para As Paragraph
Dim paraNext As Paragraph
Dim MyText As String
Set doc = ActiveDocument
Set para = doc.Paragraphs.First
Do While Not para Is Nothing
Set paraNext = para.Next
MyText = "(U//FOUO) "
If para.Style = doc.Styles(wdStyleBodyText) Then
para.Range.InsertBefore (MyText)
End If
Set para = paraNext
Loop
End Sub
These macros are running slowly and, at the end, generating Error 28 Out of stack space errors. However the error is displayed at the end of running the macros and after the macros have successfully performed their work.
I have quite a large word document (> 400 pages) with lots of cross references to headings. So far, I have always referred to the title of the heading, but now I would like to change that and refer to the page the heading resides on.
I didn't find a solution to this via the GUI (except manual treatment, of course), so I was looking into writing some VBA. Unfortunately, I have only found a way to list all targets that can be cross referenced (via GetCrossReferenceItems), but I need a way to access the actual cross reference field.
Can you help me with that? Is a cross reference field the same as a hyperlink?
Cross-references are fields in a Word document, and can be accessed via the Fields collection (ActiveDocument.Fields). You can loop through them like any other collection and check their types to see if it's one you want to work on. It looks like cross-references to text are type 3 (wdFieldRef) and cross-references to page numbers are type 37 (wdFieldPageRef). Changing fields can be a little tricky; the following should get you started:
Sub ChangeFields()
Dim objDoc As Document
Dim objFld As Field
Dim sFldStr As String
Dim i As Long, lFldStart As Long
Set objDoc = ActiveDocument
' Loop through fields in the ActiveDocument
For Each objFld In objDoc.Fields
' If the field is a cross-ref, do something to it.
If objFld.Type = wdFieldRef Then
'Make sure the code of the field is visible. You could also just toggle this manually before running the macro.
objFld.ShowCodes = True
'I hate using Selection here, but it's probably the most straightforward way to do this. Select the field, find its start, and then move the cursor over so that it sits right before the 'R' in REF.
objFld.Select
Selection.Collapse wdCollapseStart
Selection.MoveStartUntil "R"
'Type 'PAGE' to turn 'REF' into 'PAGEREF'. This turns a text reference into a page number reference.
Selection.TypeText "PAGE"
'Update the field so the change is reflected in the document.
objFld.Update
objFld.ShowCodes = True
End If
Next objFld
End Sub
I have a document that is roughly 200 pages and is essentially a list of test procedures for a specific software. Now this document has certain parts to it the pertain to different versions of the software and these parts are mixed in so their not nicely formatted in a specific order. What I would like to do is Be able to hide the parts of the document that are not needed when testing a different version. I know MS word has a font option to hide text but I would like to be able to setup up a button/hypertext link/macro that will easily hide the unneeded sections. Is this possible and how would I do it? I've started experimenting with VBA script to design my own macro but have only found a way to hide one part per shortcut hit. Is there a way to do this so all parts are effected simultaneously?
EDIT:
The document is organized like this
Version 1
Test Option button
/
Version 2
Test Option button
Check that Sample button is disabled
/
Version 1
Test Save button
/
Version 3
Test Save to USB button
/
So as you can see it's completely unorganized the code I currently have for one macro really doesn't work because instead of selecting between the two point I specify it selects the whole document.
Sub TextSelectTest()
'
' TextSelectTest Macro
' Base Test
'
With Selection.Find
.Text = "Version1"
.Forward = False
.MatchWildcards = False
.Wrap = wdFindStop
.Execute
End With
Selection.Extend
With Selection.Find
.Text = "/"
.Forward = True
.Execute
.Text = ""
End With
Selection.Extend
With Selection.Font
.Hidden = True
End With
End Sub
I don't think hiding font is most professional solution as the result is visible only for printing. But that could be the easiest in this situation especially you suggested it.
First step: set sections in your documents. It's quite easy and should be done ones in Word app. You will need to insert as many section separation marks as many parts of the document you need to manage. We will need to know which section should be/shouldn't be part of each Manual but I'll back to that later.
Second steps: Than you will need the following subroutine which will 'hide' all sections and than show appropriate ones:
Sub HideUnhide_Document_Section(secIndex As Variant)
Dim Doc As Document
Set Doc = ActiveDocument
Dim secDoc As Variant
'to hide all section first, by iteration
For Each secDoc In Doc.Sections
secDoc.Range.Font.Hidden = True
Next secDoc
'alternatively we could hide whole content without iteration:
'secDoc.Content.Font.Hidden = True
'to un-hide chosen sections
For Each secDoc In secIndex
Doc.Sections(secDoc).Range.Font.Hidden = False
Next secDoc
End Sub
And to manage your hiding process I would propose the following code:
Sub Call_Hide()
Dim arrVersion1 As Variant
'put all sections for appropriate version
arrVersion1 = Array(1, 3)
'to unhide
HideUnhide_Document_Section arrVersion1
End Sub
You could either prepare similar separate subroutine for each version or parametrize that one. It that second situation it will have to have separate arrays (arrVarsionX) for each Version of your manuals.