vb.net highlight text in word - vb.net

I am using VB.NET in VS 2012 Express to automate Word 2010.
I am trying to find a string and then highlight it in Turquoise. My code works to find and highlight it, but it does it in the default yellow color. How can I change that to the desired color?
I apologize if this is a silly question, I am teaching myself VB by writing this.
For x As Integer = 0 To (dateConnected.Count() - 1)
With oRng.Find
.MatchCase = False
.ClearFormatting()
.Text = dateConnected(x)
With .Replacement
.ClearFormatting()
.Text = dateConnected(x)
.Highlight = Word.WdColor.wdColorTurquoise
End With
.Execute(Replace:=Word.WdReplace.wdReplaceAll)
End With
Next

the Highlight property accept true or false,
the color index is determined by the DefaultHighlightColorIndex property, Which member Option property of application instance.
code:
ApplicationInstant.Options.DefaultHighlightColorIndex = Word.WdColorIndex.wdTurquoise
.Highlight = True

Related

Find/Replace an Inserted Check Box Symbol with a Check Box Content Control

I would like to find/replace all inserted check box symbols with checkbox content controls. The symbol's font is Wingdings (either 111 or 168). Below is the code I started with, but I hit a wall when I realized that Word find doesn't recognize the symbol. I appreciate any help or guidance. Thank you.
Sub ReplaceUnicode168()
Dim objContentControl As ContentControl
With ActiveDocument
Set objContentControl = ActiveDocument.ContentControls.Add(wdContentControlCheckBox)
objContentControl.Cut
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.Text = Chr(168)
.Replacement.Text = "^c"
.Execute Replace:=wdReplaceAll
End With
End With
End Sub
I suggest that you try to find/replace these two particular characters using
.Text = ChrW(61551)
for the "111" WingDings Character and
.Text = ChrW(61608)
for the "168" WingDings character.
Be aware that the way Word encodes these characters is not very helpful. As far as Find/Replace is concerned, you have to use these Unicode Private Use Area encodings.
If you actually select the character and use VBA to discover its code using e.g.
Debug.Print AscW(Selection)
the answer is always 40 (and the Font of the character will probably be the same as the Surrounding font) Pretty useless. In older versions of Word you used to be able to look for the 40 character and find these characters, but I don't think that's possible now. But if you select the character and use
Sub SymInfo()
With Dialogs(wdDialogInsertSymbol)
' You won't see .Font and .CharNum listed under the
' properties of a Word.Dialog - some older Dialogs add
' per-Dialog properties at runtime.
Debug.Print .Font
Debug.Print .CharNum
End With
End Sub
Then you get the font name (Wingdings in this case) and the private use area character number, except it's expressed as a negative number (-3928 for Wingdings 168). The character to use in the Find/Replace is 65536-3928 = 61608.
Alternatively, you can find the private use area code by selecting the character, getting its WordOpenXML code, then finding the XML element that gives the code (and the font). Ideally use MSXML to look for the element but the following gives the general idea.
Sub getSymElement
Dim finish As Long
Dim start As Long
Dim x As String
x = Selection.WordOpenXML
start = Instr(1,x,"<w:sym")
' Should check for start = 0 (not found) here.
finish = Instr(start,x,">")
Debug.Print Mid(x,start, finish + 1 - start)
and for the 168 character you should see something like
<w:sym w:font="Wingdings" w:char="F0A8"/>
(Hex F0A8 is 61608)
There may be a problem where Word could potentially map more than one font/code to the same unicode private use area codepoint. There is some further code by Dave Rado here but I do not think you will need it for this particular problem.
After some follow-up, the following seems to work reasonably well here:
Sub replaceWingdingsWithCCs()
Dim cc As Word.ContentControl
Dim charcode As Variant
Dim ccchecked As Variant
Dim i As Integer
Dim r As Word.Range
' Make sure the selection point is not in the way
' (If the selection contains one of the characters you are trying to
' replace, Word will raise an error about the selection being in a
' plain text content control.
' If the first item in the document is not a CC,
' it's enouugh to do this:
ActiveDocument.Select
Selection.Collapse WdCollapseDirection.wdCollapseStart
' Put the character codes you need to look for here. Maybe you have some checked boxes too?
charcode = Array(61551, 61608)
' FOr each code, say whether you want a checked box (True) or an unchecked one.
ccchecked = Array(False, False)
For i = LBound(charcode) To UBound(charcode)
Set r = ActiveDocument.Range
With r.Find
.ClearFormatting
With .Replacement
.ClearFormatting
.Text = ""
End With
.Forward = True
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.Text = ChrW(charcode(i))
Do While .Execute(Replace:=True)
Set cc = r.ContentControls.Add(WdContentControlType.wdContentControlCheckBox)
cc.Checked = ccchecked(i)
r.End = r.Document.Range.End
r.Start = cc.Range.End + 1
Set cc = Nothing
Loop
End With
Next
Set r = Nothing
End Sub

Adjusting the width of columns of all tables in a Word document

In my Word document, I have over 300 tables and I want to change the table style and adjust the columns' widths. I am using the following code in my VBA macro. It's working for a style but not for column width. Please help me find where the problem is.
Sub Makro1()
'
' Makro1 Makro
'
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Variable"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=4, Extend:=wdExtend
Selection.Tables(1).Style = "eo_tabelle_2"
With Tables(1).Spacing
.Item(1) = 5.5 'adjusts width of text box 1 in cm
.Item(2) = 8.5 'adjusts width of text box 2 in cm
.Item(3) = 7.5 'adjusts width of text box 3 in cm
.Item(4) = 1.1 'adjusts width of text box 4 in cm
End With
End Sub
I'm going to interpret your question literally: that you merely want to process all the tables in the document and that your code is using Find only in order to locate a table...
The following example shows how you can work with the underlying objects in Word directly, rather than relying on the current Selection, which is what the macro recorder gives you.
So, at the beginning we declare object variables for the Document and a Table. The current document with the focus is assigned to the first. Then, with For Each...Next we can loop through each Table object in that document and perform the same actions on each one.
In this case, the style is specified and the column widths set. Note that in order to give a column width in centimeters it's necessary to use a built-in conversion function CentimetersToPoints since Word measures column width in Points.
Sub FormatTables
Dim doc as Document
Dim tbl as Table
Set doc = ActiveDocument
For Each tbl in doc.Tables
tbl.Style = "eo_tabelle_2"
tbl.Columns(1).Width = CentimetersToPoints(5.5)
tbl.Columns(2).Width = CentimetersToPoints(8.5)
tbl.Columns(3).Width = CentimetersToPoints(7.5)
tbl.Columns(4).Width = CentimetersToPoints(1.1)
Next
End Sub
As far as I can recall all the tables in a word file are a part of Tables collection and we can access the individual table item using an index. Assuming that you wont know the number of tables, here's the code that works for me.
For Each tbl In Doc.Tables
tbl.Columns(3).Width = 40
Next

Word VBA - Applying alternate font color via styles does not work with text that has direct formatting (of font color) applied

I have created a template (one of a series of many similar templates) that will be distributed to multiple users to be used to create transcripts (of audio and digital files). The transcript includes a number of styles that will be used exclusively to format the text.
The template includes a series of macros that temporarily changes the font colors of each of the custom styles in order to aid in a quick proofing of the format, and then another macro to change them all back to the black/auto font color.
As long as there is no direct formatting of font colors within any of the custom styles, this process works swimmingly. However, I am contemplating the possibility that some users might opt to select all the text and use the direct formatting method to restore the temp-colored fonts to black. If they do this, it renders all of the color-centric macros (change to a color, change back to black) useless.
This could be very problematic because the transcripts produced by these users will ultimately be submitted to a subcontractor, who may wish to employ the color-centric macros herself for additional proofing before submitting the final transcript to her client. But they will no longer work if the user has applied direct formatting of font colors.
I was able to remove the direct-formatting font color, both manually and via a macro, by using the "clear formatting" option, then reapplying the style. But that is not a practical solution for this conundrum because any given paragraph might contain other attributes such as bold, underlining, or italicized text, which is lost when the "clear formatting" option is applied. I contemplated applying character styles to those attributes, but there is no way I can guarantee that a user will use them, so there is still a risk of losing the attributes when trying to deal with the potential font color issue.
I have conducted exhaustive experiments in Word and searched through the help files as well as extensively on Google, and I cannot find any information that facilitates removing ONLY the direct formatting relative to font colors while leaving other direct formatting attributes intact so that I can employ the macros to change the font colors within the styles.
Am I missing the forest for the trees and going about this all wrong? Or is there one little element lacking in my macro code that would address this problem?
I have copied the two main color-centric macros below. There are actually 8 additional macros that are part of this same category, because I'm also giving the user the option to change the font color in individual styles as well as the QUESTION and ANSWER style together (while not changing any other styles). But they are just identical snippets of the code shown below, paired down to deal with individual styles.
Thanks in advance for any help!
Change all the styles to a different color:
Sub STYLES_AllColors()
With ActiveDocument.Styles("#CENTERED (DS)")
.Font.ColorIndex = wdGray50
End With
With ActiveDocument.Styles("#FLUSH LEFT (DS)")
.Font.ColorIndex = wdDarkYellow
End With
With ActiveDocument.Styles("#PARENTHETICAL")
.Font.ColorIndex = wdViolet
End With
With ActiveDocument.Styles("#QUESTION (looped)")
.Font.ColorIndex = wdRed
End With
With ActiveDocument.Styles("#ANSWER (looped)")
.Font.ColorIndex = wdBlue
End With
With ActiveDocument.Styles("#QA2 (continuing paragraph)")
.Font.ColorIndex = wdTurquoise
End With
With ActiveDocument.Styles("#QA (plain format)")
.Font.ColorIndex = wdDarkRed
End With
End Sub
Change all the styles back to black/auto:
Sub STYLES_AllBlack()
With ActiveDocument.Styles("#CENTERED (DS)")
.Font.Color = wdColorAutomatic
End With
With ActiveDocument.Styles("#FLUSH LEFT (DS)")
.Font.Color = wdColorAutomatic
End With
With ActiveDocument.Styles("#PARENTHETICAL")
.Font.Color = wdColorAutomatic
End With
With ActiveDocument.Styles("#QUESTION (looped)")
.Font.Color = wdColorAutomatic
End With
With ActiveDocument.Styles("#ANSWER (looped)")
.Font.Color = wdColorAutomatic
End With
With ActiveDocument.Styles("#QA2 (continuing paragraph)")
.Font.Color = wdColorAutomatic
End With
With ActiveDocument.Styles("#QA (plain format)")
.Font.Color = wdColorAutomatic
End With
End Sub
I may have found the answer, or at least a suitable workaround for now.
After more experimenting, it seems that even if direct formatting (of font colors) has been applied to the text, the macro-generated font changes will work if I use the find/replace method to search for the individual styles and change the font, rather than applying the font changes directly to the style (within the macro), as I was doing. That results in a lot of extra formatting styles, but I can provide the users with instructions and tools to prevent and/or eliminate that clutter on the Formatting Pane.
So unless someone comes along with a more elegant solution, that's what I'll go with for now. Here is a snippet of the code for an individual style. I will have to expand it to cover all of the styles, and create a companion macro to remove all the colors.
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("#QUESTION (looped)")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles( _
"#QUESTION (looped)")
With Selection.Find.Replacement.Font
.Color = wdColorRed
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
I have a similar problem when I use EndNote to manage a bibliography. It remakes the style every update. I run a macro that calls several others to put in links and optional spaces. I think that the subroutine I run to cleanup the EndNote Bibliography paragraph style and paragraph instances may provide a view to the scheme that I use.
I have included that code below, it also will cut down on the explosion of Direct Styles.
I first make sure that the style itself is what I want. Then I go to each instance and set it to the same. Now, these are paragraphs, the character style is similar. If you are still watching this question, let me know, and I will write up the character style code. It can use a subroutine that just runs through an array of styles and colors.
Private Sub EndNoteStyleFixup(d As Document, r As Range)
'
' EndNoteBibliographyStyleFix Macro
'
'
Dim ENStyle As Style
Dim p As Paragraph
Dim pCnt As Long
Set ENStyle = Nothing
On Error Resume Next
Set ENStyle = d.Styles("EndNote Bibliography")
On Error GoTo 0
If ENStyle Is Nothing Then
'done
Else
pCnt = 0
With ENStyle
.Font.name = "Times New Roman"
.Font.Size = 10.5
With .ParagraphFormat
.LeftIndent = InchesToPoints(0.25)
.RightIndent = InchesToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 2
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.Hyphenation = True
.FirstLineIndent = InchesToPoints(-0.25)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
doEndNoteTabs .TabStops
End With
.NoSpaceBetweenParagraphsOfSameStyle = False
.AutomaticallyUpdate = False
.BaseStyle = "Normal"
.NextParagraphStyle = "EndNote Bibliography"
End With
For Each p In r.Paragraphs
If ENStyle = p.Style Then
p.Range.Select
With p.Range
.Font.name = "Times New Roman"
.Font.Size = 10.5
With .ParagraphFormat
.LeftIndent = InchesToPoints(0.25)
.RightIndent = InchesToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 2
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.Hyphenation = True
.FirstLineIndent = InchesToPoints(-0.25)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
doEndNoteTabs .TabStops
End With
End With
p.Style = ENStyle
End If
Next p
End If
End Sub

How to use VBA to convert text in Microsoft Word

I want all our old Word documents at the Uni to start to have accessible styles applied. For this test, I want to set up a macro to search a Word doc and wherever it finds 11pt Arial, I want it to apply an Accessible Style which will be Verdana 11pt. In doing this, it means academic staff could more easily convert non-accessible documents into more accessible documents.
I've started learning macro and can create one which saves the Word file out to PDF, which is a useful shortcut but I'm struggling.
I've tried creating a macro to open Replace, look for any instances of Arial 11pt and then replace them all with another style, but when I run it, it seems to apply my alternative style but also adds weird boxes to the document.
Also, if I apply the Header Style to the doc and then manually edit that style to be Arial 11pt then when I run the macro, the text seems to get the new Style applied but what I see is still Arial, and I get the weird boxes!
I would love to crack this on my own but it's not an area I am familiar with so any help from the community would be fantastic.
Here's the macro code, which I created using the recorder:
Sub Style()
'
' Style Macro
'
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 11
.Bold = False
.Italic = False
End With
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("Written Stuff")
With Selection.Find.Replacement.ParagraphFormat
With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorBlack
.BackgroundPatternColor = wdColorBlack
End With
.Borders.Shadow = False
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
In this example, instead of using Verdana I'm using Algeria so I can more easily see the font changes.
You are looking for a text attribute Font="Arial 11pt" and then want to apply a Paragraph style. Probably attributes applied to text of a paragraph have a higher priority than the attributes of the style of the parapgraph.
When you say "Also, if I apply the Header Style to the doc and then manually edit that style to be Arial 11pt then..." you are NOT manually editing the style but are editing the text of a pragraph that has a style. (Editing the style would mean editing the definition of the style, and the style can have been applied to many paragraphs).
You can do two things:
Replace the text-level font with the text-level new font, or
Remove the text-level font attribute and apply the paragraph style.

MS Word VBA: How to replace each word with its translation while keeping formatting

I have a word document and want to replace each single word with its translation while keeping all the formatting intact. I cannot use "Find And Replace" dialog because I am not trying replace a particular set of words but I am replacing all the words. How do I do that using VBA?
Update
I am using Word 2010. So far, I can loop through the words using ActiveDocument.Range.Words property but I don't know how to replace those words with its translation? While replacing, I want to keep all the formattings like font name, size, color, background color, underline, bold in short all the formatting options as it is.
I guess you have an array of words ("apple", "book", "cat") and the array of their translation ("pomme", "livre", "chat").
Your goal is to bulk change words one by one.
So you need a loop. Here is the loop that may help (if I understand your problem correctly).
Bulk change upon two arrays:
Option Explicit
Sub replaceArrayForArray()
'
'to create array use prefix\suffix and replacing tool http://textmechanic.com/
'
'
findArray = Array("apple", "book", "cat")
replArray = Array("pomme", "livre", "chat")
For i = 0 To UBound(findArray)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = findArray(i)
.Replacement.Text = replArray(i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute replace:=wdReplaceAll
Next i
End Sub
The more diffucult issue could have been if you worked with figures and you had to bulk change figures without overlap. The method with the use of the same macro more or less described here: MS Word Macro to increment all numbers in word document.