Description | VBA Code |
Message Box with line break | Sub TwoLine() Application.ScreenUpdating = False MsgBox “This is the first line,” & vbCrLf & _ “and this is the second line.” End Sub |
Message Box with Yes/No | Sub YesNo() Application.ScreenUpdating = False Dim strAnswer as String strAnswer = MsgBox("Do you want Print Layout view?", vbYesNo, _ "Decision Box") If strAnswer = vbYes Then ActiveWindow.View.Type = wdPrintView Else ActiveWindow.View.Type = wdNormalView End If End Sub |
Prompt user for text | Sub Prompt() Application.ScreenUpdating = False Dim strName as String strName = InputBox("Enter your name:", "REQUEST FOR INFO") Selection.TypeText Text:=strName End Sub |
Prompt user for file name | Sub Filename() Application.ScreenUpdating = False Dim strVar as String strVar = InputBox("Enter a file name", "LIBRARY FILES") On Error GoTo ErrorHandler If strVar <> "" Then Selection.InsertFile FileName:="C:\My Documents\" + _ strVar End If Exit Sub ErrorHandler: MsgBox ("Filename " + strVar + _ " does not exist. Try again.") End Sub |
Show a built-in dialog box with specific tab displayed | Sub PaperSource() Application.ScreenUpdating = False With Dialogs(wdDialogFilePageSetup) .DefaultTab = wdDialogFilePageSetupTabPaperSource .Show End With End Sub |
Insert AutoText and its formatting | Sub TextInsert() Application.ScreenUpdating = False ActiveDocument.AttachedTemplate.AutoTextEntries("Confidential").Insert Where:=Selection.Range, RichText:=True End Sub |
Go to a bookmark in a document | Sub FindSpot() Application.ScreenUpdating = False If ActiveDocument.Bookmarks.Exists("Addressee") = True Then Selection.GoTo What:=wdGoToBookmark, _ Name:="Addressee" Else MsgBox “No Addressee bookmark exists in this document.” End If End Sub |
Select and insert a name from your Address Book | Sub AddressBkName() Application.ScreenUpdating = False Dim strChoice as String, strVar as String strChoice = Application.GetAddress strVar = Application.GetAddress(Name:=strChoice, _ AddressProperties:="<PR_GIVEN_NAME>" + " <PR_SURNAME>") Selection.TypeText Text:=strVar End Sub |
Update fields in document and in headers/footers | Sub UpdateAll() Application.ScreenUpdating = False Dim sec As Section ActiveDocument.Fields.Update For Each sec In ActiveDocument.Sections sec.Headers(wdHeaderFooterPrimary).Range.Fields.Update sec.Headers(wdHeaderFooterFirstPage).Range.Fields.Update sec.Footers(wdHeaderFooterPrimary).Range.Fields.Update sec.Footers(wdHeaderFooterFirstPage).Range.Fields.Update Next End Sub |
Update Table of Contents | Sub UpdateTOC() Application.ScreenUpdating = False Dim toc As TableOfContents For Each toc In ActiveDocument.TablesOfContents toc.Update Next End Sub |
Perform an action repeatedly | Sub RepeatAction() Application.ScreenUpdating = False For Count = 1 To 5 Selection.TypeText Text:="tedious text" Selection.TypeParagraph Next Count End Sub |
Display or hide a toolbar | Sub HideToolbar() Application.ScreenUpdating = False If CommandBars("Web").Visible = False Then CommandBars("Web").Visible = True Else CommandBars("Web").Visible = False End If End Sub |
Test whether insertion point is in a table | Sub InTable() Application.ScreenUpdating = False If Selection.Information(wdWithInTable) = True Then Selection.Cells.Shading.BackgroundPatternColor = _ wdColorGold Else MsgBox "Your insertion point is not inside a table." End If End Sub |
Reset the Browser to browse by page | Sub ResetBrowser() Application.ScreenUpdating = False Application.Browser.Target = wdBrowsePage End Sub |
If no document window is open, create a new one | Sub TestWindow() Application.ScreenUpdating = False If Documents.Count < 1 Then Documents.Add Template:="Normal", NewTemplate:=False End If End Sub |
Turn Spelling and Grammar wavy lines on or off | Sub WavyOnOff() Application.ScreenUpdating = False If ActiveDocument.ShowGrammaticalErrors = True Then ActiveDocument.ShowSpellingErrors = False ActiveDocument.ShowGrammaticalErrors = False Else If ActiveDocument.ShowSpellingErrors = True Then ActiveDocument.ShowSpellingErrors = False ActiveDocument.ShowGrammaticalErrors = False Else ActiveDocument.ShowSpellingErrors = True ActiveDocument.ShowGrammaticalErrors = True End If End If Application.ScreenRefresh End Sub |
Close a file without saving it | Sub CloseNoSave() Application.ScreenUpdating = False ActiveWindow.Close SaveChanges:=wdDoNotSaveChanges End Sub |
| Autonumber without styles: 1st Level = 1. | Sub NumberingLevel1() Application.ScreenUpdating = False With ListGalleries(3).ListTemplates(1).ListLevels(1) .NumberFormat = "%1." .TrailingCharacter = wdTrailingTab .NumberStyle = wdListNumberStyleArabic .NumberPosition = InchesToPoints(0.5) .Alignment = wdListLevelAlignLeft .TextPosition = InchesToPoints(0) .TabPosition = InchesToPoints(1) .ResetOnHigher = 0 End With Selection.Range.ListFormat.ApplyListTemplate _ ListTemplate:=ListGalleries(3).ListTemplates(1), _ ContinuePreviousList:=True Selection.Range.ListFormat.ListLevelNumber = 1 Selection.ParagraphFormat.Space2 Selection.ParagraphFormat.SpaceAfter = 0 End Sub |
| Autonumber without styles: 2nd Level = a. | Sub NumberingLevel2() Application.ScreenUpdating = False With ListGalleries(3).ListTemplates(1).ListLevels(2) .NumberFormat = "%2." .TrailingCharacter = wdTrailingTab .NumberStyle =wdListNumberStyleLowercaseLetter .NumberPosition = InchesToPoints(1) .Alignment = wdListLevelAlignLeft .TextPosition = InchesToPoints(1.5) .TabPosition = InchesToPoints(1.5) .ResetOnHigher = 1 End With Selection.Range.ListFormat.ApplyListTemplate _ ListTemplate:=ListGalleries(3).ListTemplates(1), _ ContinuePreviousList:=True Selection.Range.ListFormat.ListLevelNumber = 2 Selection.ParagraphFormat.Space1 Selection.ParagraphFormat.SpaceAfter = 12 End Sub |
| Autonumber without styles: 3rd Level = i. | Sub NumberingLevel3() Application.ScreenUpdating = False With ListGalleries(3).ListTemplates(1).ListLevels(3) .NumberFormat = "%3." .TrailingCharacter = wdTrailingTab .NumberStyle = wdListNumberStyleLowercaseRoman .NumberPosition = InchesToPoints(2.5) .Alignment = wdListLevelAlignLeft .TextPosition = InchesToPoints(2) .TabPosition = InchesToPoints(2) .ResetOnHigher = 1 End With Selection.Range.ListFormat.ApplyListTemplate _ ListTemplate:=ListGalleries(3).ListTemplates(1), _ ContinuePreviousList:=True Selection.Range.ListFormat.ListLevelNumber = 3 Selection.ParagraphFormat.Space1 Selection.ParagraphFormat.SpaceAfter = 12 End Sub |
