Miscellaneous small Microsoft Word 6.0 WordBasic macros

AllCapitals

Makes the selection all capitals.  Unlike the built-in AllCaps Word command, 
it actually changes it (not just a format).  I re-assigned THIS macro to the 
built-in Word 6 "to caps" button.

REM 1-2-99
REM ACTUALLY CHANGES SELECTION TO ALL CAPS.  DOESN'T JUST FORMAT IT THAT WAY.
Sub MAIN
FormatChangeCase .Type = 2
End Sub

DocMaximizeToggle

I assigned it to key F5 so Word behaves like the Borland IDE.

Sub MAIN
DocMaximize
End Sub

SETBookmarkTEMP

Define the current cursor location as a bookmark named TEMP.  Assigned to key CTRL+SHIFT+0.

Sub MAIN
EditBookmark .Name = "temp", .SortBy = 0, .Add
End Sub

GOTOBookmarkTEMP

Go to the bookmark named TEMP.  Assigned to key CTRL+0.
Sub MAIN
EditGoTo .Destination = "temp"
End Sub

MoveBlockToBookmarkTEMP

Moves the currently selected block to previously defined bookmark TEMP.

'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.) 
Sub MAIN
If Not ExistingBookmark("temp") Then
	MsgBox "Bookmark TEMP does not exist.", "Cannot Move Block", 48
	Goto bye
End If
EditCut
EditBookmark .Name = "temp", .SortBy = 0, .Goto
EditPaste
EditBookmark .Name = "temp", .SortBy = 0, .Add
bye:
End Sub

Grep

Does a Grep-like search within the active doc.

Sub MAIN
REM 11/30/00
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 MSWORD .DOC FILES.
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 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
StartOfDocument
EditFind
While EditFindFound()
	EndOfLine
	StartOfLine 1
	Print #1, Selection$()
	REM TO AVOID ENDLESS LOOP IF SEARCH STRING IS THE PMARK
	EndOfLine
	CharRight	
	EditFind
Wend
Close #1
FileOpen .Name = "D:\TEMP\GREPFIND.DOC"
bye:
End Sub

TabIn

TABS IN a line or block, using TAB chars.

Sub MAIN
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(Selection$()) <= 1 Then
	StartOfLine					'ALSO CANCELS SELECTION, IF ANY
	Insert Chr$(9)
	Goto bye
EndIf
REM ----------------------------------------------------------------------------
CopyBookmark "\Sel", "xxTabTemp"
SelType 1
leaveloop = 0
While CmpBookmarks("\Sel", "xxTabTemp") = 8 \
		Or CmpBookmarks("\Sel", "xxTabTemp") = 6 \
		Or CmpBookmarks("\Sel", "xxTabTemp") = 10 \
		And leaveloop <> 1
	EndOfLine
	If CmpBookmarks("\Sel", "\EndOfDoc") = 0 Then leaveloop = 1
	StartOfLine
	Insert Chr$(9)
	LineDown
Wend
EditGoTo "xxTabTemp"
EditBookmark "xxTabTemp", .Delete
bye:
End Sub

TabOut

TABS OUT a line or block, using TAB chars.

Sub MAIN
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(Selection$()) = 1 Then
	StartOfLine					'ALSO CANCELS SELECTION, IF ANY
	If Selection$() = Chr$(9) Then EditClear
	Goto bye
EndIf
REM ----------------------------------------------------------------------------
REM THIS PART MODIFIED FROM TABIN()
CopyBookmark "\Sel", "xxTabTemp"
SelType 1
leaveloop = 0
While CmpBookmarks("\Sel", "xxTabTemp") = 8 \
		Or CmpBookmarks("\Sel", "xxTabTemp") = 6 \
		And leaveloop <> 1
	EndOfLine					
	If CmpBookmarks("\Sel", "\EndOfDoc") = 0 Then leaveloop = 1
	StartOfLine
	If Selection$() = Chr$(9) Then EditClear
	LineDown
Wend
EditGoTo "xxTabTemp"
EditBookmark "xxTabTemp", .Delete
bye:
End Sub

ScrollTextDown

Scrolls the document window down without moving the cursor.

Sub MAIN
Rem OPTIONAL
Rem EditGoTo .Destination = "L-8"
VLine -8
End Sub

ScrollTextUp

Scrolls the document window up without moving the cursor.

Sub MAIN
Rem OPTIONAL
Rem EditGoTo .Destination = "L+8"
VLine 8
End Sub

ScrollToWindowBottom

Scrolls current insertion point (if possible) to the bottom of the window.
I think this may be (or once was) used by WADAPT.CPP (WADAPT.EXE)
when using DDE to output its reports and logs to a Word file.

Sub 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 IF YOU WANT TO SCROLL TO TOP, JUST CALL THIS, THEN DO A PageDown.
Rem 1/10/02
Rem I think this may be used by WADAPT.CPP (WADAPT.EXE).

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

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

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 AtEndOfDocument()
    StartOfWindow 0
    If LineUp(1, 0) = 0 Then GoTo Bye
    EndOfWindow 0
Wend
Rem if target WAS end of doc, scroll end back into view and quit.
If CmpBookmarks("ScrollStart", "\EndOfDoc") = 0 Then VLine 1: GoTo Bye

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

Bye:
EditGoTo Destination:="AbsStart"
EditBookmark Name:="AbsStart", SortBy:=0, Delete:=1
EditBookmark Name:="ScrollStart", SortBy:=0, Delete:=1

End Sub

 

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

QuoteFirstString

Sub MAIN
Rem QUOTEFIRSTSTRING
Rem 7/18/01
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.
StartOfDocument
While Not AtEndOfDocument()
    StartOfLine
    If [Selection$]() <> Chr(34) Then
        Insert Chr(34)
        WordRight 1
        CharLeft 1
        Insert Chr(34)
    End If
    EndOfLine
    LineDown
Wend
StartOfLine
If [Selection$]() <> Chr(34) Then
    Insert Chr(34)
    WordRight 1
    CharLeft 1
    Insert Chr(34)
End If

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

endofdocument
Bye:
End Sub

ToDatabase

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

Sub MAIN
StartOfDocument
While (AtEndOfDocument() = 0)
    StartOfLine
    Insert Chr(34)
    EndOfLine
    WordLeft 3
    Insert Chr(34) + ","
    LineDown 1
Wend
End Sub

Web this Site News

Copyright ©2007 Steven Whitney. Last modified 09/25/2007.