Macros in Minutes
Take two minutes to paste a macro into your Normal template, and improve your life!
Wednesday, May 26, 2021
Getting You Started
Queries? Meet me at www.ChrisGreaves.com
Tuesday, November 29, 2011
Convert Hyperlinks To Proper Case
By mis-adventure I often enough end up with hyperlinks in a mish-mash of cases.
I'd like all the hyperlinks to conform to a consistent standard.
Sub ConvertHyperlinksToProperCase()Dim HLNK As Hyperlink
For Each HLNK In ActiveDocument.Hyperlinks
With HLNK
Dim strTextToDisplay As String
strTextToDisplay = .TextToDisplay
.TextToDisplay = StrConv(strTextToDisplay, vbProperCase)
End With
Next HLNK
End Sub
This little macro does that.
Note that it processes EVERY hyperlink in the current document, which is fine for me.
If you wanted it to operate only on a selected area you could change one line to read
For Each HLNK In Selection.Hyperlinks
Monday, October 3, 2011
Quick Keys Quickies
The mantra is “If it’s boring and repetitive, WRITE A MACRO”, but who has time to catalogue a vast array of macros which, having been used once, can be discarded?
The solution lies in recording a macro and assigning it to a fixed shortcut key combination, and to ease your transition into this amazing world, I’ve recorded a three-minute video which you can see through YouTube, or in higher definition (and longer download time) from my video collection.
I’ll spell out the keyboard sequences you need in the table below; you may want to print it out for future reference.
In the table below I suggest you use Ctrl-Shift-K as your shortcut key combination; it is not assigned to any special command in Microsoft Word, and is easy to remember.
I’ve used “{Your keyboard sequence}” to represent whatever keystrokes you require to perform your action one time. You will, of course, merely use the keyboard to perform your action one time.
Keyboard sequence | Full command |
Alt-T, M, R | Choose Tools, Macro, Record |
Alt-K, Ctrl-Shift-K, Enter, Enter | Choose Keyboard, Ctrl-Shift-K as the shortcut key |
{Your keyboard sequence} | Here is where you will use the keyboard to perform the |
Alt-T, M, R | Choose Tools, Macro, stop Recording. |
That’s it!
Position your cursor at the start of the text to be modified, hold down both the Ctrl and Shift keys, and tap the letter “K” repeatedly.
Here’s a full example of my assigning to Ctrl-Shift-K a macro that will insert alternate sequence fields at the head of a set of paragraphs.
Keyboard sequence | Full command |
---|---|
Alt-T, M, R | Choose Tools, Macro, Record |
Alt-K, Ctrl-Shift-K, Enter, Enter | Choose Keyboard, Ctrl-Shift-K as the shortcut key combination, Assign, Close. |
(, Ctrl-F9,seq,,question,, ,), | This inserts a sequence field “question”, surrounded by parentheses, with a space between the closing parenthesis and the paragraph text. |
Ctrl-Down-Arrow | This moves to the next paragraph |
(, Ctrl-F9,seq,,answer,, ,), | This inserts a sequence field “answer”, surrounded by parentheses, with a space between the closing parenthesis and the paragraph text. |
Ctrl-Down-Arrow | This moves to the next paragraph |
Alt-T, M, R | Choose Tools, Macro, stop Recording. |
Friday, September 30, 2011
Detect Duplicate words in sentences
unlike Microsoft Word's grammar/spell checker which merely identifies consecutive duplicate words, this macro (and associated function) marks in RED second and subsequent occurrences of words in each sentence.
A short list of noise words is provided as a string constant; we don't mind those words being repeated.
Public Const strcIgnoreWords As String = vbTab & "and" & vbTab & "on" & vbTab & "the" & vbTab
Sub DuplicateWordsInSentences()
Dim prg As Paragraph
For Each prg In ActiveDocument.Paragraphs
Dim snt As Range
For Each snt In prg.Range.Sentences
Call FindDupInSentence(snt)
Next snt
Next prg
End Sub
Function FindDupInSentence(snt As Range)
Dim strAllWords As String
strAllWords = vbTab
Dim wd As Range
For Each wd In snt.Words
Dim strWd As String
strWd = Trim(wd.Text)
If Len(strWd) > 1 Then
If InStr(1, strcIgnoreWords, vbTab & strWd & vbTab) > 0 Then ' we ignore this word
Else
If InStr(1, strAllWords, vbTab & strWd & vbTab) > 0 Then
wd.Font.Color = wdColorRed
Else
strAllWords = strAllWords & strWd & vbTab
End If
End If
Else ' we ignore words of length 1 character
End If
Next wd
End Function
Monday, September 19, 2011
File Diversion
Here's some stripped-down proof-of-concept code:
Public Const strcNewDrive As String = "J:"
Sub FileSave()
MsgBox "FileSave"
If Len(ActiveDocument.Path) = 0 Then ' not previously saved
Call SaveAsDialog(strcNewDrive, ActiveDocument.Name)
Else
If UCase(Left(ActiveDocument.Path, 2)) = strcNewDrive Then ' User is logged on to th drive
ActiveDocument.Save
Else
Call SaveAsDialog(strcNewDrive, ActiveDocument.Name)
End If
End If
End Sub
Sub FileSaveAs()
MsgBox "FileSaveAs"
Call SaveAsDialog(strcNewDrive, ActiveDocument.Name)
End Sub
Function SaveAsDialog(strDrive As String, strName As String)
With Application.Dialogs(wdDialogFileSaveAs)
.Name = strDrive & "\" & strName
.Format = wdFormatDocument
.Show
End With
End Function
Wednesday, August 31, 2011
Rebuild your Active Document
Use the little macro "RebuildActiveDocument" to grab all your text, unformatted, and rebuild the document.
CAUTION: make a copy of your document using Windows Explorer before running this macro.
Sub RebuildActiveDocument()
' Get the name of the source ActiveDocumentument
Dim strFilename As String
strFilename = ActiveDocument.FullName
' Get the stoty-content of the ActiveDocumentument
Dim strStoryContent As String
Dim lng As Long
For lng = 1 To ActiveDocument.StoryRanges.Count
strStoryContent = strStoryContent & ActiveDocument.StoryRanges(lng).Text
Next lng
' Close the ActiveDocumentument WITHOUT saving changes
ActiveDocument.Close (wdDoNotSaveChanges)
' Create a new ActiveDocumentument
Documents.Add
' Insert the text file
Selection.TypeText (strStoryContent)
' Save the ActiveDocumentument with the original name
ActiveDocument.SaveAs (strFilename)
End Sub
Thursday, August 18, 2011
Print View, Whole page, All documents
I like to see them in a consistent manner.
Perhaps they are a set of flyers, and I want to make sure that the layout above-the-fold is identical.
This little macro loops through all open documents, moves the cursor to the top of the document, then chooses Print View (WYSIWYG, almost) and a whole-page on the screen.
Sub PrintViewAll()
Dim doc As Document
For Each doc In Application.Documents
doc.Activate
Selection.HomeKey Unit:=wdStory
ActiveWindow.View.Type = wdPrintView
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
Application.WindowState = wdWindowStateMaximize\
Next doc
End Sub
P.S. If you'd rather be left at the foot of the documents, to append new text, use:-
Selection.EndKey Unit:=wdStoryP.P.S. If you'd rather be left in Normal view, use:
ActiveWindow.View.Type = wdNormalView