I've written a small VBA program to remove trailing whitespace from MS Word table cells. It iterates through all the cells of each table and modifies their .Range.Text object using the command
C.Range.Text = myRE.Replace(C.Range.Text, "")
where myRE is a VBScript RegExp 5.5 object and myRE.Pattern = "\s+(?!.*\w)". The entire program can be found here.
The program works fine except for one problem. It removes all the comments from the cells as well. Before:
After (the extra space is gone, but so is the comment):
Looking at the local object tree, I can see that changing C.Range.Text also changes C.Range.Comments - but why?
What can I do to prevent this?
When you work with Range.Text, as is the case whenever RegEx or, indeed, any function that manipulates strings is used, all formatting and other non-text characters are lost when a pure string is written back to the cell.
For example, if a single character in your cell text were formatted as Bold, the bold formatting would be lost. Or if change tracking were in the cell - it would be lost. Any Footnote or Endnote would be lost. Comments fall into this same category.
You need a different approach, one that respects how Word stores non-text information in a document. Here's a suggestion that loops the cells in a table, picks up the Range at the end of the cell, then moves the starting point of the Range back as long as a pre-defined Whitespace character is found. When this criterium is no longer met, the Range is deleted. (Note I don't know why I needed to use Range.Delete twice - the first time had no effect.)
You need to work out what for you is "whitespace". I used a space, a carriage return and a tab character. You can certainly add others to the sWhitespace string.
Sub RemoveWhiteSpaceEndOfCell()
Dim cel As word.Cell
Dim sWhitespace As String
Dim rng As word.Range
Dim lWhiteSpaceChars As Long
'define what constitutes Whitespace.
'Here: a space, a carriage return and a tab
sWhitespace = Chr(32) & Chr(13) & Chr(9)
For Each cel In ActiveDocument.Tables(1).Range.Cells
Set rng = cel.Range
'set the Range to the end of the cell
rng.Collapse wdCollapseEnd
rng.MoveEnd wdCharacter, -1
'move the starting point back as long as whitespace is found
lWhiteSpaceChars = rng.MoveStartWhile(sWhitespace, wdBackward)
'Only if whitespace was found, delete the range
If lWhiteSpaceChars <> 0 Then
'rng.Select 'For debugging purposes
rng.Delete
rng.Delete
End If
Next
End Sub
Related
I am trying to export a Word document from a Visual Basic program. Different parts of the document will need different formatting.
I have several paragraphs, and I need to bold only portions of each of those paragraphs. I am trying to set the range within each paragraph that needs to be bolded, but no matter what I do, it only seems to want to to bold the entire paragraph.
I want to do something like this:
Dim Para1 As Word.Paragraph
Para1 = WordDoc.Content.Paragraphs.Add
Para1.Range.Start = 1
Para1.Range.End = 14
Para1.Range.Font.Bold = True
Para1.Range.Text = "Job number is: " + myJobID
... so that it bolds from the 'J' to the ':' (in Para1.Range.Text) but does not bold the myJobID (which is a variable I'm getting from the user). However, no matter what I do, it bolds the entire paragraph, including the myJobID.
I've also tried creating a Range variable that sets a range based on the entire document, but the problem with that is, the lengths of several variables I'm outputting on the Word document are going to be varying sizes, and thus there's no way to know where the start of the next section I want to bold will start at. So basically, I have to work within the Paragraph object rather than iterating through all of the characters in the entire document.
Hope that made sense. Any ideas?
In order to format individual text runs it's necessary to break the text down into individual runs when inserting. Also, it's best to work with an independent Range object. Between formatting commands the Range needs to be "collapsed" - think of it like pressing the right (or left) arrow of a selection to make it a blinking cursor. Something along these lines
Dim Para1 As Word.Paragraph
Dim rng as Word.Range
Para1 = WordDoc.Content.Paragraphs.Add
rng = Para1.Range
rng.Text = "Job number is: "
rng.Font.Bold = True
rng.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
rng.Text = myJobID
rng.Font.Bold = False
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
If it's really necessary to insert the full text in one go, then Find/Replace to locate the text that should be formatted differently is one way to format after-the-fact, although less efficient.
Another possibility is to use string manipulation functions, such as Instr (or Contains), Left, Mid etc. to determine where in a longer string the substring is located. Then Range.Start and Range.End can work with those values. But generally it's better to not rely on the start and end values since Word can insert non-visible characters that can throw this numbering off.
Create another Range object that only covers the characters that you want to bold.
The code below is not tested (don't have full VS set up on this machine), but should give you an idea:
Dim para1 As Word.Paragraph
Dim textToBeBolded As Word.Range
para1 = WordDoc.Content.Paragraphs.Add 'ThisDocument.Paragraphs.Add in VBA
para1.Range.Text = "Job number is: " + myJobID
para1.Range.SetRange 1, 14
textToBeBolded = para1.Range
textToBeBolded.SetRange 1, 14
textToBeBolded.Font.Bold = True
I'm going through a text character by character.
With this Sub.
Believe me it works.
Sub Recorrida2()
prepararVariables
For Each parrf In ActiveDocument.Paragraphs
DoEvents
Dim c As Integer
c = 1
For Each car In parrf.Range.Characters
If cargaAPatron(car) Then
MsgBox "lleno ok"
Selection.TypeText ("ENTER")
lleno = 1
End If
Next 'parrafo
Next
End Sub
My problem is that I want to insert a text when I detect a pattern.
This way it does not work
Selection.TypeText ("ENTER")
Because it inserts the "ENTER" at the beginning of the text, instead of inserting it in the place of detection.
What am I doing wrong?
Thanks in advance!
Word's Character object is also a Range object. So the following should work:
car.InsertParagraphAfter
Generally, working with the Selection object should be avoided when automating Word. There are a very few things for which it's necessary, but writing text to a document is not one of them...
If, instead, the paragraph mark should be inserted a number of characters before the target Range (car), you can extend the start of the Range using the MoveStart method:
car.MoveStart wdCharacter, -n
car.InsertParagraphBefore
Where n is the number of characters you want to go backwards.
I am new to VBA so I am struggling with what seems to be quite a simple task.
I have a few lines of text in each cell in a word document. Each cell contains a category such "Science" or "Health" or one of several others. At the minute I'm actually just using a special character such as "*" or "#" for testing purposes.
I need the text colour of all text in the cell to change depending on which category is in the cell. So the txt would be e.g. green for "Science" and red for "Health".
It seems that running a macro is quickest way of making these changes (there will be over 200 such cells in my final document and colouring manually is such a waste of time). Basically, I'm struggling with first changing the colour of all the text in the cell, and secondly how to make the macro search again if the first criteria is not met. I would like 1 macro that could complete colouring for the entire document, rather than having multiple macros for each colour I need.
If you could give me some examples of VBA I could work with that would be most helpful. I'm really struggling and any help you could give will save me and my team so much time.
This should perform reasonably well unless your document is huge or your keyword list is huge or both.
Sub ColorCells()
Dim tbl As Table
Dim rw As Row
Dim cll As Cell
Dim i As Long
Dim Keywords As Variant, Colors As Variant
'if you have more than one table, you have to look through them
Set tbl = ThisDocument.Tables(1)
'Make two arrays - one with keywords and the second with colors
'where the colors are in the same position in their array as the
'keywords are in theirs
Keywords = Array("Science", "Health")
Colors = Array(wdBlue, wdDarkRed)
'Loop through every row in the table
For Each rw In tbl.Rows
'Loop through every cell in the row
For Each cll In rw.Cells
'Loop through every keyword in your array
For i = LBound(Keywords) To UBound(Keywords)
'if the keyword exist, change the color and stop checking
'further keywords
If InStr(1, cll.Range.Text, Keywords(i)) > 0 Then
cll.Range.Font.ColorIndex = Colors(i)
Exit For
End If
Next i
Next cll
Next rw
End Sub
If you want to use custom colors instead of built in ones, change the Colors array assignment line to
Colors = Array(RGB(192, 192, 192), RGB(188, 25, 67))
and the line where you set the color to
cll.Range.Font.TextColor.RGB = Colors(i)
Whenever I select a section of text in MS Word using this code:
Dim aRange As Range
Set aRange = ActiveDocument.Range( _
Start:=ActiveDocument.Paragraphs(1).Range.Start, _
End:=ActiveDocument.Paragraphs(3).Range.End)
aRange.Select
everything is fine except that Word automatically alters the selection to add a new line character at the end of the selection. How to avoid it? Perhaps it is possible to change the selection so that it will not include a new line character.
My question is similar to another one already asked, but I would like it to do it using VBA.
When you work with selections on the keyboard you use Shift + Left/Right Arrow keys to change the extent of the selection. In the Word object model there's an equivalent you can use with the Range object; actually, there's a set of methods: MoveStart, MoveEnd, MoveWhile, MoveUntil
In this case, you need the MoveEnd method. You can move the end point by a specific set of units, such as characters, words, paragraphs - you want to move by one character, going "backwards", so:
aRange.MoveEnd wdCharacter, -1
aRange.Select
This should work:
doc.Paragraphs(1).Range.Select
Selection.MoveEnd wdCharacter, -1
Selection.Copy
I was wondering how to avoid using Windows clipboard, when you want to "replicate" multiple sections of a Word document (using VBA in macros)
Why to avoid? Because we're using Word on a server, in a multiuser environment (I know that it is officially frowned upon)
Otherwise, this would be easily accomplished with Selection.Copy and Selection.Paste methods.
Thanks.
I finally resolved to copy word by word. FormattedText seemed to work fairly well, until the last word (some special (evidently) characters), where suddenly the cell that I just filled with copied content would go blank. When I increased the number of cells, other run-time errors would pop up, like Your table got corrupted, and other ambiguous ones. Somehow, the source cell that I was copying from always seemed to have these peculiar chars in the end with ASCII codes 13 and 7. I know what 13 means, but 7?
Anyway, I decided to copy everything apart from this last character with code 7. It seems to work alright. Both formatting and fields are copied too.
In any case, the whole story proved to me for one more time that programming in VBA is mostly trial-and-error occupation. You are never sure when something might break.. unless I am missing update on some crucial concepts..
Here's the chunks of the code I used. The idea is that first we have a document with a single 1x1 cell table, with some rich text content. In the first piece of the code (inside a macro) I multiply the cells:
Dim cur_width As Integer, i As Integer, max_cells As Integer, cur_row As Integer
Dim origin_width As Integer
If ActiveDocument.Tables.Count = 1 _
And ActiveDocument.Tables(1).Rows.Count = 1 _
And ActiveDocument.Tables(1).Columns.Count = 1 _
Then
max_cells = 7 ' how many times we are going to "clone" the original content
i = 2 ' current cell count - starting from 2 since the cell with the original content is cell number 1
cur_width = -1 ' current width
cur_row = 1 ' current row count
origin_width = ActiveDocument.Tables(1).Rows(1).Cells(1).Width
' loop for each row
While i <= max_cells
' adjust current width
If cur_row = 1 Then
cur_width = origin_width
Else
cur_width = 0
End If
' loop for each cell - as long as we have space, add cells horizontally
While i <= max_cells And cur_width + origin_width < ActiveDocument.PageSetup.PageWidth
Dim col As Integer
' \ returns floor() of the result
col = i \ ActiveDocument.Tables(1).Rows.Count
// 'add cell, if it is not already created (which happens when we add rows)
If ActiveDocument.Tables(1).Rows(cur_row).Cells.Count < col Then
ActiveDocument.Tables(1).Rows(cur_row).Cells.Add
End If
// 'adjust new cell width (probably unnecessary
With ActiveDocument.Tables(1).Rows(cur_row).Cells(col)
.Width = origin_width
End With
// 'keep track of the current width
cur_width = cur_width + origin_width
i = i + 1
Wend
' when we don't have any horizontal space left, add row
If i <= max_cells Then
ActiveDocument.Tables(1).Rows.Add
cur_row = cur_row + 1
End If
Wend
End If
In the second part of the macro I populate each empty cell with the contents of the first cell:
' duplicate the contents of the first cell to other cells
Dim r As Row
Dim c As Cell
Dim b As Boolean
Dim w As Range
Dim rn As Range
b = False
i = 1
For Each r In ActiveDocument.Tables(1).Rows
For Each c In r.Cells
If i <= max_cells Then
// ' don't copy first cell to itself
If b = True Then
' copy everything word by word
For Each w In ActiveDocument.Tables(1).Rows(1).Cells(1).Range.Words
' get the last bit of formatted text in the destination cell, as range
' do it first by getting the whole range of the cell, then collapsing it
' so that it is now the very end of the cell, and moving it one character
' before (because collapsing moves the range actually beyond the last character of the range)
Set rn = c.Range
rn.Collapse Direction:=wdCollapseEnd
rn.MoveEnd Unit:=wdCharacter, Count:=-1
' somehow the last word of the contents of the cell is always Chr(13) & Chr(7)
' and especially Chr(7) causes some very strange and murky problems
' I end up avoiding them by not copying the last character, and by setting as a rule
' that the contents of the first cell should always contain an empty line in the end
If c.Range.Words.Count <> ActiveDocument.Tables(1).Rows(1).Cells(1).Range.Words.Count Then
rn.FormattedText = w
Else
'MsgBox "The strange text is: " & w.Text
'the two byte values of this text (which obviously contains special characters with special
'meaning to Word can be found (and watched) with
'AscB(Mid(w.Text, 1, 1)) and AscB(Mid(w.Text, 2, 1))
w.MoveEnd Unit:=WdUnits.wdCharacter, Count:=-1
rn.FormattedText = w
End If
Next w
End If
b = True
End If
i = i + 1
Next c
Next r
Here are the images of the Word document in question. First image is before running the macro, second is between the first chunk of code and the last, while the third image is the resulting document.
Image 1
Image 2
Image 3
That's it.
In Office 2007+ VSTO, you can export the block with Range.ExportFragment and then go to your new document and import it with Range.ImportFragment. I haven't used this in production, but experimented with it and it seems to work OK.
One caveat, I got errors when trying to export as a .docx, but RTF seemed to work ok.
Both methods exist in VBA as well, but I only tested the VSTO methods.
This doesn't always work, with text fields, diagramms, for example, or if you need to copy it to another document, but it's good for copying simple formatted text inside one document.
'First select something, then do
Word.WordBasic.CopyText
'Then move somewhere
Word.WordBasic.OK;
To copy the whole document to a new document use this:
Word.Application.Documents.Add Word.ActiveDocument.FullName
I ran into a similar issue. I wanted to copy a table from one word doc to another using Powershell without using the clipboard. Since a user using the computer while the script ran could break the script by using the clipboard. The solution I came up with was:
Open the source document and put a bookmark covering the range of what I wanted (in my case a single table).
Save the source document with its bookmark in another location (to avoid changing the source document).
Opened the destination document and created a range object for where I wanted the table placed.
Used range.InsertFile with the first parameter of the source file with my bookmark and the second parameter of my bookmark name. This single operation pulled the entire table plus source formatting directly into the destination document.
I then added code based on where the insertion was being done and how much longer the story was to select the inserted table to allow further operations on it.
I tried many any other methods to move the table and this was by far the best. Sorry I can't provide VBA code for this solution.
Use the Text property of the Selection object to put the data into a string variable rather than onto the clipboard:
Dim strTemp as String
strTemp = Selection.Text
You can then insert the text stored in the variable elsewhere as needed.