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
Related
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
I am trying to select the underlined words between two sections of a word document and save them to a collection variable. I am building this in Blue Prism, which utilizes vb.net.
I have the following code, which is working, but it seems to be selecting all underlined words in the document (and also is selecting some blank lines), instead of only selecting the underlined words between the two specific sections in the document.
Document looks like this (ÜWord Document Example) :
I would want to select "Example1" and "Example3" in the document and save them to a variable, since those are between the two sections and underlined. The two section names will always be the same.
Here's the code I currently have:
Dim w As Object = doc.Application
Dim s As Object = w.Selection
Dim Para as Microsoft.Office.Interop.Word.Paragraph
Dim blnStart as Boolean
blnStart = false
Dim table As New System.Data.DataTable()
table.Columns.Add("Underlined_Text", GetType(String))
For Each Para In doc.Paragraphs
If Para.Range.Text.ToLower.Contains(strStartText) Then
blnStart = true
End If
If Para.Range.Font.Underline = 1 and blnStart Then
With s.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Underline = 1
.Text = ""
.Replacement.Text = ""
.Format = True
.Forward = True
.Wrap = 0
.Execute
End With
.Select
table.Rows.Add(s.Range.Text)
End With
End If
If Para.Range.Text.ToLower.Contains(strEndText) Then
exit for
End If
Next Para
Underlined_Text = table
doc = Nothing
The variables 'strStartText' and 'strEndText' would be equal to the two section names.
So, I am working with VBA on a word template which for every item (requirements in this case) contains a table with different specifications (all the tables are in the same format) and some other information. Below each table I have a text which shows the status of each item like: status: Approved or Work, or Rejected etc. I am asked to delete all the other statuses in the template and keep only the "Rejected" status and the whole information and table with that has this status to format in a light grey. Does anybody has any idea how to navigate to all tables, information, and specify the section I need to Format? I am very new to this and I am completely stucked! Here's some code I wrote:
Sub DeleteWorkflow()
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Normal")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Italic = False
With Selection.Find.Replacement.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
End With
With Selection.Find
.Text = "Status: Approved"
.Text = "Status: Work"
.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
Selection.Find.Execute
'Finds status "Rejected" and changes the font color
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Status: Rejected"
.Forward = True
.Wrap = Word.WdFindWrap.wdFindContinue
.Font.ColorIndex = wdGray50
Selection.Find.Execute
End With
The code to find the rejected status and to change its color is not working and I am not getting it why. Any idea?
Basis of the idea
The idea is to look through the sentences of the word document. Sentences comprise regular text and also text contained within tables.
As you load all the sentences in a single object in VBA, you can look through the content of the document sentences by sentences and perform an action on it.
We can also apply that type of search to tables within the document, if the text they contain match the characters you want.
The code
For sentences
Sub SENTENCE_CHANGE_COLOR()
Dim i As Long
Dim oSentences As Sentences
'Here we instantiate the variable oSentences to store all the values of the current opened document
Set oSentences = ThisDocument.Sentences
' We loop through every fields of the document
For i = 1 To oSentences.Count
' The property .Text contains the text of the item in it
' Then we just have to look for the text within the string of characters
If InStr(oSentences.Item(i).Text, "Status: Rejected") Then
'Do some stuff, like changing the color
oSentences.Item(i).Font.ColorIndex = wdGray50
else
' Do some other things like changing the color to a different color
oSentences.Item(i).Font.ColorIndex = wdGray25
End If
Next i
End Sub
For tables
Sub TABLE_CHANGE_COLOR()
Dim i As Long
Dim oTables As Tables
'Here we instantiate the variable oTables to store all the tables of the current opened document
Set oTables = ThisDocument.Tables
' We loop through every fields of the document
For i = 1 To oTables.Count
' Finding the occurence of the text in the table
If Not InStr(oTables.Item(i).Range.Text, "Status: Rejected") = 0 Then
'Do some stuff, like changing the color
oTables.Item(i).Range.Font.ColorIndex = wdGray50
End If
Next i
End Sub
Combination of the above methods
After we found the occurrence of a "Status: Rejected" document we can select the table right before it by comparing the table's end to the start of the occurrence.
Beware since the following code would modify any table before "Status: rejected". So if "Status: rejected" is input in an incorrect location, it will modify the previous table wherever this table will be in the document.
Sub REJECTED_TABLE_CHANGE_COLOR()
Dim i As Long, j As Long
Dim oSentences As Sentences
Dim oTables As Tables
'Here we instantiate the variable oSentences to store all the values of the current opened document
Set oSentences = ThisDocument.Sentences
'Here we instantiate the variable oTables to store all the tables of the current opened document
Set oTables = ThisDocument.Tables
' We loop through every fields of the document
For i = 1 To oSentences.Count
' The property .Text contains the text of the item in it
' Then we just have to look for the text within the string of characters
If InStr(oSentences.Item(i).Text, "Status: Rejected") Then
' When we have found the correct text, we try to find the table just above it
' We start from the last table
' This condition ensures we do not start looking for before the first table
If oTables.Item(1).Range.End < oSentences.Item(i).Start Then
j = oTables.Count
While oTables.Item(j).Range.End > oSentences.Item(i).Start
j = j - 1
Wend
oTables.Item(j).Range.Font.ColorIndex = wdGray50
End If
End If
Next i
End Sub
This solution would provide you the basis to edit the document when the matching criteria is found within an item.
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.
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.