Visual Basic in Word

Application.ListCommands ListAllCommands:=True

create a new document and list all the commands and their shortcuts

Selection.Tables(1).Select
                                    

                                    Selection.Cells.Shading.BackgroundPatternColorIndex = wdAuto

remove the background colors of all the table cells (but select the whole table…)

CommandBars("Web").Enabled = False

avoid the Web bar to be displayed when a hyperlink is clicked on
Dialogs(wdDialogFileOpen).Show

display the Open dialog
see page Built-in dialog box argument lists for the list of dialogs

Selection.Find.MatchWildcards = True
                                    

                                    Selection.Find.Text = "[a-z]"

matches é,è, ù…

Selection.Find.MatchWildcards = True
                                    

                                    Selection.Find.Replacement.Highlight = True

use the current highlight colour, i.e. this will do nothing if there is currently no highlight colour

Retrieve the bookmarks of a part of the document

For i = 1 To newDoc.Tables(1).Rows.Count
                                    

                                        Set c1 = newDoc.Tables(1).Cell(i, 1) 
                                    

                                        Set c2 = newDoc.Tables(1).Cell(i, 2) 
                                    

                                        c2.Select
                                    

                                        If c1.range.Bookmarks.Count = 1 Then
                                    

                                            Dim t As String
                                    

                                            t = c1.range.Bookmarks(1)
                                    

                                            Selection.InsertAfter t
                                    

                                        End If
                                    

                                    Next i

Set range = actDoc.range(firstCell.range.Start, firstCell.range.End - 1)
                                    

                                    If (Not range.Font.StrikeThrough) Then
                                    

                                        …
                                    

                                    End If

Test if the text of a table cell is not stroke through

It is difficult to handle tables with merged cell. In the case of a table where the first column contains merged cells, I used the following code to get the cell of the first column associated with the each cell of the last column:


For i = 2 To table.Rows.Count
                                    

                                        ' Set firstCell = table.Cell(i, 1) ' this does not work for merged cells, we use the following kludge instead
                                    

                                        Set lastCell = table.Cell(i, table.Columns.Count) 
                                    

                                        lastCell.Select
                                    

                                        For j = 1 To table.Columns.Count - 1
                                    

                                            Selection.MoveLeft Unit:=wdCell
                                    

                                        Next j
                                    

                                        Set firstCell = Selection.Cells(1) 
                                    

                                        ' end of kludge
                                    

                                        …
                                    

                                    Next i

If you just want to loop on the cells of the first column, you can use


For Each firstCell In table.Columns(1).Cells
                                    

                                        …
                                    

                                    Next firstCell

document

create a new document


Dim newDoc As Document
                                    

                                    Set newDoc = Documents.Add

Document.Name is the file name without the path
Document.Path is the path of the file name
Document.FullName is the file name with its the path prepended
Application.PathSeparator is the separator to use to build folder names

it orders to avoid problems when paring documents which may be a master document and/or in revision mode:

Documents.Open FileName:=srsName(s), ReadOnly:=True
                                    

                                    WordBasic.AcceptAllChangesInDoc
                                    

                                    ActiveDocument.Subdocuments.Expanded = True
                                    

                                    Set actdoc = ActiveDocument
                                    

                                    … 
                                    

                                    
                                    use actdoc
                                    

                                    … 
                                    

                                    actdoc.Close SaveChanges:=wdDoNotSaveChanges

paragraphs

OutlineLevel returns the outline level of the paragraph, it can be wdOutlineLevel1, wdOutlineLevel2,… or wdOutlineLevelBodyText.

range.ListFormat.ListString returns the numbering of a paragraph


Sub ExtractOutline()
                                    

                                    
                                    

                                        Dim p, p1, p2 As Paragraph
                                    

                                        Dim actDoc, newDoc As Document
                                    

                                    
                                    

                                        Set actDoc = ActiveDocument
                                    

                                        Set newDoc = Documents.Add
                                    

                                    
                                    

                                        For Each p In actDoc.Paragraphs
                                    

                                            If (p.OutlineLevel <> wdOutlineLevelBodyText) Then
                                    

                                                newDoc.Content.InsertAfter (p.range.ListFormat.ListString & vbTab & actDoc.range(p.range.Start, p.range.End - 1))
                                    

                                                newDoc.Content.InsertParagraphAfter
                                    

                                            End If
                                    

                                        Next p
                                    

                                    
                                    

                                    End Sub

To add a bullet to a paragraph


Paragraphs(newDoc.Paragraphs.Count).Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1)

The following code does not work, even paragraphs are not bulleted (I have not analyzed yet why):


For s = 0 To UBound(list)
    newDoc.Content.InsertAfter (list(s))
    newDoc.Paragraphs(newDoc.Paragraphs.Count).Range.ListFormat.ApplyBulletDefault
    newDoc.Content.InsertParagraphAfter
Next s

It must be


For s = 0 To UBound(list)
    newDoc.Content.InsertAfter (list(s))
    newDoc.Paragraphs(newDoc.Paragraphs.Count).Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1)
    newDoc.Content.InsertParagraphAfter
Next s

tables

sometimes, setting borders does not work

With theTable.Range.Borders
                                    

                                        .InsideLineStyle = wdLineStyleSingle
                                    

                                        .OutsideLineStyle = wdLineStyleSingle
                                    

                                    End With

fails to draw the vertical inner borders, but

theTable.Select
                                    

                                    With Selection.Borders
                                    

                                        .InsideLineStyle = wdLineStyleSingle
                                    

                                        .OutsideLineStyle = wdLineStyleSingle
                                    

                                    End With

works
(on the same document, theTable.range.Borders(wdBorderVertical) is undefined…)

When retrieving the content of a cell will cell.range.Text, the returned text contains at its end ASCII 13 (carriage return) and ASCII 7 (which is used as an End of Cell indicator). They must be removed (Replace(cell.range.Text, vbCr & Chr(7), "") or Left(cell.range.Text, len(cell.range.Text)-2).
When writing in a cell, there is no need to add these two characters, cell.range.Text = "foobar" just work well.

statistics

display the statistics toolbar

CommandBars("Word Count").Visible = True
display the statistics dialog

Application.Dialogs(wdDialogDocumentStatistics).Show

retrieve some values from the statistics dialog (not tested)

With Dialogs(wdDialogDocumentStatistics)
                                    

                                        MyVar = .FileName
                                    

                                        MyVar2 = .Paragraphs
                                    

                                        …
                                    

                                    End With

easier macro execution

When executing a macro which modifies a lot of data, Word displays a confirmation message from time to time indicating that the action will not be cancellable because of insufficient memory. To avoid this, the macro should regularly call newDoc.UndoClear.

create a macro automatically executed when a document is opened

in the project window, double click on "This Document"
select Document from the drop-down object list
select Open from the drop-down procedure list

type the code in the inserted empty macro

Private Sub Document_Open()
                                    

                                    …
                                    

                                    End Sub

check the security level (Tools>Macros>Security), otherwise the application may simply ignore the macro

transfer some data to Excel

Private Function formatForExcel(str As String) As String
                            

                                Dim s As String
                            

                                formatForExcel = str
                            

                                formatForExcel = Replace(formatForExcel, """", """""")
                            

                                formatForExcel = Replace(formatForExcel, "“", """""")
                            

                                formatForExcel = Replace(formatForExcel, "”", """""")
                            

                                formatForExcel = Replace(formatForExcel, Chr(171), """""")
                            

                                formatForExcel = Replace(formatForExcel, Chr(187), """""")
                            

                                formatForExcel = """" & formatForExcel & """" & vbTab
                            

                            End Function

                            

                            
                            

                            
                            

                            Set newDoc = Documents.Add
                            

                            newDoc.Content.InsertAfter (formatForExcel("data 1 1"))
                            

                            newDoc.Content.InsertAfter (formatForExcel("data 1 2"))
                            

                            newDoc.Content.InsertAfter (formatForExcel("data 1 3"))
                            

                            newDoc.Content.InsertParagraphAfter
                            

                            newDoc.Content.InsertAfter (formatForExcel("data 2 1"))
                            

                            newDoc.Content.InsertAfter (formatForExcel("data 2 2"))
                            

                            newDoc.Content.InsertAfter (formatForExcel("data 2 3"))
                            

                            newDoc.Content.InsertParagraphAfter
                            

                            newDoc.SaveAs FileName:= "foobar.txt", FileFormat:=wdFormatText
                            

                            newDoc.Close
                            

                            
                            

                            Dim xl As Variant
                            

                            Set xl = CreateObject("Excel.Application")
                            

                            xl.Workbooks.Open "foobar.txt"
                            

                            xl.Cells.Select
                            

                            xl.Selection.Columns.AutoFit
                            

                            xl.Selection.Rows.AutoFit

versions

of the application

Msgbox "The version of Word is " & Application.Version
of the OS

Msgbox "The system version is " & System.Version

screen refresh

stop the automatic refresh of the screen

Application.ScreenUpdating = False
restart the automatic refresh of the screen

Application.ScreenUpdating = True
refresh the screen

Application.ScreenRefresh
set the text in the status bar

StatusBar = "Please wait…"

Macro interruption

use CtrlBreak to stop a macro
disable CtrlBreak

Application.EnableCancelKey = wdCancelDisabled
re-enable CtrlBreak

Application.EnableCancelKey = wdCancelInterrupt