25 Years of Programming
An open source source for C, C++, OWL, BASIC, MDB, XLS, DOT, and more...

Home Projects Up Sitemap Search Blog Forum+Chat About Us Privacy Terms of Use Feedback FAQ Images Services Ads Donate Humor

Language translation
by Google is available
when JavaScript enabled.
Google Translate
is an alternative.

Miscellaneous Microsoft Word 2003 Visual Basic macros

These were converted from the Word 6.0 versions.

AllCapitals

Attribute VB_Name = "AllCapitals"

Rem 1-2-99
Rem ACTUALLY CHANGES SELECTION TO ALL CAPS.  DOESN'T JUST FORMAT IT THAT WAY.
Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "Makes the selection all capitals.  Unlike AllCaps, it actually changes it (not just a format).  I have re-assigned THIS macro to the ""to caps"" button."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.AllCapitals.MAIN"
WordBasic.FormatChangeCase Type:=2
End Sub

DocMaximizeToggle

Attribute VB_Name = "DocMaximizeToggle"

Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "I assigned it to key F5 so Word behaves like the Borland IDE."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.DocMaximizeToggle.MAIN"
WordBasic.DocMaximize
End Sub

SETBookmarkTEMP

Attribute VB_Name = "SETBookmarkTEMP"

Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "Define the current cursor location as a bookmark named TEMP.  Assigned to key CTRL+SHIFT+0."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.SETBookmarkTEMP.MAIN"
WordBasic.EditBookmark Name:="temp", SortBy:=0, Add:=1
End Sub

GOTOBookmarkTEMP

Attribute VB_Name = "GOTOBookmarkTEMP"

Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "Go to the bookmark named TEMP.  Assigned to key CTRL+0."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.GOTOBookmarkTEMP.MAIN"
WordBasic.WW7_EditGoTo Destination:="temp"
End Sub

MoveBlockToBookmarkTEMP

Attribute VB_Name = "MoveBlockToBookmarkTEMP"

'8-30-97 Move currently selected block to bookmark temp.  Then move the
'bookmark to the end of the just-pasted selection, so any additional
'moved blocks will be appended there.
'(You can accomplish nearly the same thing with F2.)
Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "Moves the currently selected block to previously defined bookmark TEMP."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.MoveBlockToBookmarkTEMP.MAIN"
If Not WordBasic.ExistingBookmark("temp") Then
    WordBasic.MsgBox "Bookmark TEMP does not exist.", "Cannot Move Block", 48
    GoTo Bye
End If
WordBasic.EditCut
WordBasic.EditBookmark Name:="temp", SortBy:=0, GoTo:=1
WordBasic.EditPaste
WordBasic.EditBookmark Name:="temp", SortBy:=0, Add:=1
Bye:
End Sub

Grep

Attribute VB_Name = "Grep"

Public Sub MAIN()
Attribute MAIN.VB_Description = "Does a Grep-like search within the active doc."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.Grep.MAIN"
Rem 11/30/00
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Rem GREP-LIKE UTILITY: FINDS ALL INSTANCES OF YOUR SEARCH STRING,
Rem WRITES TO A FILE THE LINES THAT CONTAIN THEM, THEN OPENS THE FILE FOR REVIEW.
Rem BEFORE RUNNING, YOU MUST FIRST DO 1 SEARCH, TO AND FILL IN THE FIND DIALOG BOX.
Rem THE REAL GREP.EXE DOESN'T WORK ON .DOC FILES.

WordBasic.MsgBox "Edit this macro to specify a disk file to write to, then remove these 2 lines.", "Cannot continue", 48
Goto bye

Rem (I THINK THERE IS A WAY TO RUN THE FIND DIALOG FROM A MACRO)
If WordBasic.MsgBox("Did you already use ^F to set up the string to FIND?", "Greplike Repeat Find", 36) <> -1 Then GoTo Bye

Open "D:\TEMP\GREPFIND.DOC" For Output As 1

WordBasic.StartOfDocument
WordBasic.EditFind
While WordBasic.EditFindFound()
    WordBasic.EndOfLine
    WordBasic.StartOfLine 1
    Print #1, WordBasic.[Selection$]()
    Rem TO AVOID ENDLESS LOOP IF SEARCH STRING IS THE PMARK
    WordBasic.EndOfLine
    WordBasic.CharRight
    WordBasic.EditFind
Wend
Close 1

WordBasic.FileOpen Name:="D:\TEMP\GREPFIND.DOC"

Bye:
End Sub

TabIn

Attribute VB_Name = "TabIn"

Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "TABS IN a line or block, using TAB chars."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.TabIn.MAIN"
Dim leaveloop
Rem 1-31-99
Rem TABS A LINE OR BLOCK IN BY ONE TAB CHAR.
Rem ----------------------------------------------------------------------------
Rem IF THERE IS NO SELECTION, JUST INSERT THE TAB AT START OF CURRENT LINE
If Len(WordBasic.[Selection$]()) <= 1 Then
    WordBasic.StartOfLine                   'ALSO CANCELS SELECTION, IF ANY
    WordBasic.Insert Chr(9)
    GoTo Bye
End If
Rem ----------------------------------------------------------------------------
WordBasic.CopyBookmark "\Sel", "xxTabTemp"
WordBasic.SelType 1
leaveloop = 0
While WordBasic.CmpBookmarks("\Sel", "xxTabTemp") = 8 _
        Or WordBasic.CmpBookmarks("\Sel", "xxTabTemp") = 6 _
        Or WordBasic.CmpBookmarks("\Sel", "xxTabTemp") = 10 _
        And leaveloop <> 1
    WordBasic.EndOfLine
    If WordBasic.CmpBookmarks("\Sel", "\EndOfDoc") = 0 Then leaveloop = 1
    WordBasic.StartOfLine
    WordBasic.Insert Chr(9)
    WordBasic.LineDown
Wend
WordBasic.WW7_EditGoTo "xxTabTemp"
WordBasic.EditBookmark "xxTabTemp", Delete:=1

Bye:
End Sub

TabOut

Attribute VB_Name = "TabOut"

Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "TABS OUT a line or block, using TAB chars."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.TabOut.MAIN"
Dim leaveloop
Rem 1-31-99
Rem TABS A LINE OR BLOCK OUT BY ONE TAB CHAR.
Rem ----------------------------------------------------------------------------
Rem IF NO SELECTION, JUST DELETE THE TAB, IF ANY, AT START OF CURRENT LINE
If Len(WordBasic.[Selection$]()) = 1 Then
    WordBasic.StartOfLine                   'ALSO CANCELS SELECTION, IF ANY
    If WordBasic.[Selection$]() = Chr(9) Then WordBasic.WW6_EditClear
    GoTo Bye
End If
Rem ----------------------------------------------------------------------------
Rem THIS PART MODIFIED FROM TABIN()
WordBasic.CopyBookmark "\Sel", "xxTabTemp"
WordBasic.SelType 1
leaveloop = 0
While WordBasic.CmpBookmarks("\Sel", "xxTabTemp") = 8 _
        Or WordBasic.CmpBookmarks("\Sel", "xxTabTemp") = 6 _
        And leaveloop <> 1
    WordBasic.EndOfLine
    If WordBasic.CmpBookmarks("\Sel", "\EndOfDoc") = 0 Then leaveloop = 1
    WordBasic.StartOfLine
    If WordBasic.[Selection$]() = Chr(9) Then WordBasic.WW6_EditClear
    WordBasic.LineDown
Wend
WordBasic.WW7_EditGoTo "xxTabTemp"
WordBasic.EditBookmark "xxTabTemp", Delete:=1

Bye:
End Sub

ScrollTextDown

Attribute VB_Name = "ScrollTextDown"

Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "Scrolls the document window down without moving the cursor."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.ScrollTextDown.MAIN"
Rem OPTIONAL
Rem WordBasic.WW7_EditGoTo .Destination = "L-8"
WordBasic.VLine -8
End Sub

ScrollTextUp

Attribute VB_Name = "ScrollTextUp"

Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "Scrolls the document window up without moving the cursor."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.ScrollTextUp.MAIN"
Rem OPTIONAL
Rem WordBasic.WW7_EditGoTo .Destination = "L+8"
WordBasic.VLine 8
End Sub

ScrollToWindowBottom

Attribute VB_Name = "ScrollToWindowBottom"

Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "Scrolls current insertion point (if possible) to the bottom of the window."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.ScrollToWindowBottom.MAIN"
Rem ScrollToWindowBottom
Rem Scrolls current insertion point (if possible) to the bottom of the window.
Rem Works, but is more complicated and slower than I'd hoped.
Rem I think this may be (or once was) used by WADAPT.CPP (WADAPT.EXE)
Rem when using DDE to output its reports and logs to a Word file.
Rem IF YOU WANT TO SCROLL TO TOP, JUST CALL THIS, THEN DO A PageDown.
Rem 1/10/02

WordBasic.EditBookmark Name:="AbsStart", SortBy:=0, Add:=1
WordBasic.EndOfLine 0
WordBasic.EditBookmark Name:="ScrollStart", SortBy:=0, Add:=1

Rem if doc start is showing, you can't scroll
WordBasic.StartOfWindow 0
If WordBasic.AtStartOfDocument() Then GoTo Bye

WordBasic.EndOfWindow 0
Rem if end of doc is showing in the window, you are now there,
Rem but maybe NOT as low as you could be in the window.
Rem scroll end of doc out of sight, if you can.
While WordBasic.AtEndOfDocument()
    WordBasic.StartOfWindow 0
    If WordBasic.LineUp(1, 0) = 0 Then GoTo Bye
    WordBasic.EndOfWindow 0
Wend
Rem if target WAS end of doc, scroll end back into view and quit.
If WordBasic.CmpBookmarks("ScrollStart", "\EndOfDoc") = 0 Then WordBasic.VLine 1: GoTo Bye

Rem this puts cursor into view, so scrolldir is always down.
WordBasic.WW7_EditGoTo Destination:="ScrollStart"
WordBasic.EndOfWindow 0
While WordBasic.CmpBookmarks("ScrollStart", "\Sel") <> 0
    WordBasic.StartOfWindow 0
    If WordBasic.LineUp(1, 0) = 0 Then GoTo Bye
    WordBasic.EndOfWindow 0
Wend

Bye:
WordBasic.WW7_EditGoTo Destination:="AbsStart"
WordBasic.EditBookmark Name:="AbsStart", SortBy:=0, Delete:=1
WordBasic.EditBookmark Name:="ScrollStart", SortBy:=0, Delete:=1

End Sub

Some single-use macros (used once and kept for reference how to do it).

QuoteFirstString

Attribute VB_Name = "QuoteFirstString"

Public Sub MAIN()
Rem QUOTEFIRSTSTRING
Rem 7/18/01
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Rem I used this to add quotes around the first word (string) in
Rem all the wtalk.cpp .DIC files, for importing into wtalk.mdb.
Rem keep in case I need to do it again.

WordBasic.StartOfDocument
While Not WordBasic.AtEndOfDocument()
    WordBasic.StartOfLine
    If WordBasic.[Selection$]() <> Chr(34) Then
        WordBasic.Insert Chr(34)
        WordBasic.WordRight 1
        WordBasic.CharLeft 1
        WordBasic.Insert Chr(34)
    End If
    WordBasic.EndOfLine
    WordBasic.LineDown
Wend
WordBasic.StartOfLine
If WordBasic.[Selection$]() <> Chr(34) Then
    WordBasic.Insert Chr(34)
    WordBasic.WordRight 1
    WordBasic.CharLeft 1
    WordBasic.Insert Chr(34)
End If

WordBasic.StartOfDocument
WordBasic.EditFind Find:=Chr(34) + Chr(34), Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=0

WordBasic.endofdocument

Bye:
End Sub

ToDatabase

Similar to the previous macro. Used once to preformat text for database importing. 

Attribute VB_Name = "ToDatabase"

Public Sub MAIN()
Rem Copyright (C)2000 Steven Whitney.
Rem Published under GNU GPL (General Public License) Version 3, with ABSOLUTELY NO WARRANTY.
Attribute MAIN.VB_Description = "Used once to reformat text for database importing.\r\nKeep for reference for similar tasks."
Attribute MAIN.VB_ProcData.VB_Invoke_Func = "TemplateProject.ToDatabase.MAIN"
WordBasic.StartOfDocument
While (WordBasic.AtEndOfDocument() = 0)
    WordBasic.StartOfLine
    WordBasic.Insert Chr(34)
    WordBasic.EndOfLine
    WordBasic.WordLeft 3
    WordBasic.Insert Chr(34) + ","
    WordBasic.LineDown 1
Wend
End Sub