Background (skip if needed, there to help people Googling the same problem)
When you create text boxes in word (I was using the auto caption on figures), use italicised text and align right, you often find a bit of the last letter can be cut off.
Here's the situation where I noticed it first (zoomed in alot)
Or to accentuate with a more flourishy script:
F is a good letter to recreate this problem with. This is a known bug, and the solution on that page was to add in a non-breaking whitespace (ctrl+shift+space or chrW(160) in VBA)
Problem
I tried to create a macro to add a non breaking space to each textbox in my document, if:
The textbox is right-aligned
The text inside is italicised
There isn't one already
Here's the code I came up with:
Sub captionSpaces() 'placed in normal.dot module
Dim grp As Shape
Dim tb As Shape
Dim txRng As Range
Dim str As String
For Each grp In ActiveDocument.Shapes 'all my textboxes are in groups - I might add handling in case they aren't
For Each tb In grp.GroupItems 'Loop through all shapes in all groups
If tb.Type = msoTextBox Then 'Single out text-boxes
Set txRng = tb.TextFrame.TextRange 'Get text content
If txRng.Italic And txRng.ParagraphFormat.Alignment = wdAlignParagraphRight Then 'only act on this sort of text
str = txRng.Text
If Right(str, 1) <> ChrW(160) Then 'check for a space already present
str = str & ChrW(160) 'create new string...
txRng.Text = str '...and set it (could have done in 1 step)
End If
End If
End If
Next tb
Next grp
End Sub
'NB I appreciate I could have put all my conditions in one IF with AND,
'but I find this clearer and I think it will be marginally quicker
'since you aren't SETting the str over and over
This doesn't work for me and I am not familiar enough with Word VBA to work out why; in all but one of my captions it doesn't do anything, in one of them it seems to add 2 new lines. Very bizarre
Possible avenue; the groups are wrapped in 3 ways; Square, Tight and Top & Bottom, the captions are all beneath the images (and grouped to them). The one that gets the extra lines is the only one wrapped tight.
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 using Office 2016. I'd like to make a macro that loops through each heading in a document, and then creates a bookmark at the heading's location using the heading text (modified as necessary) as the bookmark name. Most of the headings are in X.X.X.X format, such as "3.3.4.1. sometexthere".
I'm still a beginner using VBA, but after a lot of googling I managed to adapt some Frankenstein code that almost works:
Sub HeadingsToBookmarks()
Dim heading As Range
Set heading = ActiveDocument.Range(Start:=0, End:=0)
Do
Dim current As Long
current = heading.Start
Set heading = heading.GoTo(What:=wdGoToHeading, Which:=wdGoToNext)
If heading.Start = current Then
Exit Do
End If
ActiveDocument.Bookmarks.Add MakeValidBMName(heading.Paragraphs(1).Range.Text), Range:=heading.Paragraphs(1).Range
Loop
End Sub
Function MakeValidBMName(strIn As String)
Dim pFirstChr As String
Dim i As Long
Dim tempStr As String
strIn = Trim(strIn)
pFirstChr = Left(strIn, 1)
If Not pFirstChr Like "[A-Za-z]" Then
strIn = "Section_" & strIn
End If
For i = 1 To Len(strIn)
Select Case Asc(Mid$(strIn, i, 1))
Case 49 To 58, 65 To 90, 97 To 122
tempStr = tempStr & Mid$(strIn, i, 1)
Case Else
tempStr = tempStr & "_"
End Select
Next i
tempStr = Replace(tempStr, " ", " ")
tempStr = Replace(tempStr, ":", "")
If Right(tempStr, 1) = "_" Then
tempStr = Left(tempStr, Len(tempStr) - 1)
End If
MakeValidBMName = tempStr
End Function
This code almost works, and makes appropriate bookmarks at some of the headings, but not all. Can anyone help me figure out what I need to fix here, or have other recommendations on how else I can clean up this code?
Edit: More information: The code above converts the first 5 or so headings in the document I've been testing it on, along with a few others scattered around. The second half of the code, which does the actual conversion, seems to work fine- the problem is located in the section that loops through each heading. The second half converts unusable characters to those that work with the requirements for bookmark names, and adds "Section_" to the beginning of bookmarks / headings that start with numbers (as bookmarks aren't allowed to start with numbers).
My goal is to be able to hyperlink to all sections within the document that has headings from a different word document. The standard Table of Contents creator allows only for links to be built within the same document, as far as I can tell. I'm aware that when word saves to PDF, it can convert headings to bookmarks; I would like to be able to do the same thing but retain the document in word format.
I unfortunately can't use the built in numbering. I'm working with documents that are already created and have a set and specific format.
You haven't described why you want bookmarks, or how a future user of the document would use/access the bookmarks.
MS Word has a number of built in features that act as bookmarks. The best way to do this is to use Styles. The built-in heading styles allow for some native navigation functionality (Word's own hidden bookmarks). Also, don't re-invent the wheel - use built in numbering.
This requires some document discipline. Use headings only for headings, and body text for the non-heading text.
The benefits make the discipline worth it. You can easily create tables of contents that use the headings (or even some of your custom styles), and headings show up in the navigation pane. When you save to PDF, you can use the headings as bookmarks in the PDF (show up on the Reader navigation bar).
Note that what I have described doesn't even touch VBA.
If you use set styles for your headings and you want to do a little more than what you can do natively, then you can simply:
Loop through all paragraphs in the document
See if that paragraph is set to your heading style
Place a bookmark (valid bookmark name!) over that paragraph
I have left the actual coding to you, but I think you will find it easy to do based on the pseudo code above. My pseudo code loop is not the only way to find the paragraphs, but it is the easiest to visualise.
Once you use the simplified method above and built-in numbering, you should find that you can modify your ValidBMName function - simplifying it. But, as noted and depending on why you want bookmarks, you may be able to avoid VBA altogether.
This code works for me:
Sub HeadingsToBookmarks()
Dim heading As Range
Set heading = ActiveDocument.Range(Start:=0, End:=0)
Do
Dim current As Long
current = heading.Start
Set heading = heading.GoTo(What:=wdGoToHeading, Which:=wdGoToNext)
If heading.Start = current Then
Exit Do
End If
'This is the part I changed: ListFormat.ListString
ActiveDocument.Bookmarks.Add MakeValidBMName(heading.Paragraphs(1).Range.ListFormat.ListString), Range:=heading.Paragraphs(1).Range
Loop
End Sub
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)
Does anyone know how when programmatically iterating through a word document, you can tell if a paragraph forms part of a table of contents (or indeed, anything else that forms part of a field).
My reason for asking is that I have a VB program that is supposed to extract the first couple of paragraphs of substantive text from a document - it's doing so by iterating through the Word.Paragraphs collection. I don't want the results to include tables of contents or other fields, I only want stuff that a human being would recognize as a header, title or a normal text paragraph. However it turns out that if there's a table of contents, then not only the table of contents itself but EVERY line in the table of contents appears as a separate item in Word.Paragraphs. I don't want these but haven't been able to find any property on the Paragraph object that would allow me to distinguish and so ignore them (I'm guessing I need the solution to apply to other field types too, like table of figures and table of authorities, which I haven't yet actually encountered but I guess potentially would cause the same problem)
Because of the limitations in the Word object model I think the best way to achieve this would be to temporarily remove the TOC field code, iterate through the Word document, and then re-insert the TOC. In VBA, it would look like this:
Dim doc As Document
Dim fld As Field
Dim rng As Range
Set doc = ActiveDocument
For Each fld In doc.Fields
If fld.Type = wdFieldTOC Then
fld.Select
Selection.Collapse
Set rng = Selection.Range 'capture place to re-insert TOC later
fld.Cut
End If
Next
Iterate through the code to extract paragraphs and then
Selection.Range = rng
Selection.Paste
If you are coding in .NET this should translate pretty closely. Also, this should work for Word 2003 and earlier as is, but for Word 2007/2010 the TOC, depending on how it is created, sometimes has a Content Control-like region surrounding it that may require you to write additional detect and remove code.
This is not guaranteed, but if the standard Word styles are being used for the TOC (highly likely), and if no one has added their own style prefixed with "TOC", then it is OK. This is a crude approach, but workable.
Dim parCurrentParagraph As Paragraph
If Left(parCurrentParagraph.Format.Style.NameLocal, 3) = "TOC" Then
' Do something
End If
What you could do is create a custom style for each section of your document.
Custom styles in Word 2003 (not sure which version of Word you're using)
Then, when iterating through your paragraph collection you can check the .Style property and safely ignore it if it equals your TOCStyle.
I believe the same technique would work fine for Tables as well.
The following Function will return a Range object that begins after any Table of Contents or Table of Figures. You can then use the Paragraphs property of the returned Range:
Private Function GetMainTextRange() As Range
Dim toc As TableOfContents
Dim tof As TableOfFigures
Dim mainTextStart As Long
mainTextStart = 1
For Each toc In ActiveDocument.TablesOfContents
If toc.Range.End > mainTextStart Then
mainTextStart = toc.Range.End + 1
End If
Next
For Each tof In ActiveDocument.TablesOfFigures
If tof.Range.End > mainTextStart Then
mainTextStart = tof.Range.End + 1
End If
Next
Set GetMainTextRange = ActiveDocument.Range(mainTextStart, ActiveDocument.Range.End)
End Function
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.