Macro that browses multiple selection

[Klaus Linke]

Hi all,

No question, just a macro that some might find useful...

Multiple selections (= selection of non-contiguous stuff) in Word2002/2003
are great.
But Word doesn't have too many commands to make them useful (yet).

One major gripe I have is that you can't easily browse through the selected
items/ranges, looking at them one by one.

Say you have selected a dozen words/paragraphs/cells... or more in some
book with "Edit > Find > Highlight all items found in...".
Or you have selected all occurrences of some particular style or kind of
formatting from the "Styles and formatting" pane (... right-click on some
style or formatting).

Usually, you'd like to check out some or all of the selected ranges, before
you copy or delete them, or change the formatting.
Now, the only way to check out the selected ranges is to scroll through the
whole doc (perhaps 300 pages), and look out for the selections.

The macro below shows all selected ranges one by one (with a counter in a
MessageBox showing the index -- "Multiple selection 3 of 7" ..., and an
option to cancel at any time), and restores the multiple selection
afterwards.
It's pretty clumsy, mostly because VBA doesn't have much to offer regarding
multiple selections.

The macro doesn't work for multiple selected (floating) graphics.
In tables, it will re-select only the text, even if whole cells were
selected originally.

Note that you have to change one line (containing "%F" in SendKeys) if you
use a non-English version.

Hope it may be useful! And hope there aren't serious bugs: Use it on your
own risk.
If the macro should run amuck, you can stop it with Ctrl+Pause ... And
then, you should select all text and uncheck "Format > Font > Shadow".

Perhaps, a future version of Word might add "Selection" to "Edit > GoTo"
and the browser, so you can use Ctrl+PageDown/Ctrl+PageUp to center the
screen on the next/previous selected range?

What do you think: What other commands might be useful?

Regards,
Klaus


Sub LoopMultipleSelection()

Dim myRanges As New Collection
Dim myRange As Range
Dim i As Long

' Use Font.Shadow to mark selections:
Selection.Font.Shadow = True

' Find all ranges with .Shadow=True:
Set myRange = ActiveDocument.Range(0, 0)
myRange.Find.ClearFormatting
myRange.Find.Font.Shadow = True
With myRange.Find
.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
End With
Do While myRange.Find.Execute
' Work-around for table cells:
If myRange.start = myRange.End Then
Exit Do
End If
myRanges.Add myRange.Duplicate
myRange.Collapse (wdCollapseEnd)
Loop

' Undo applying the shadow:
ActiveDocument.Undo

' Step through ranges and show them:
i = 0
For Each myRange In myRanges
i = i + 1
myRange.Select
ActiveWindow.ScrollIntoView _
Selection.Range, True
If MsgBox("Continue?", _
vbOKCancel, _
"Multiple Selection " & _
Str(i) & " of " & _
Str(myRanges.Count)) _
= vbCancel Then
Exit For
End If
Next myRange
For Each myRange In myRanges
myRange.Font.Shadow = True
Next myRange

' Use EditFind Dialog to
' restore the multiple selection:
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Font.Shadow = True
With Selection.Find
.Text = ""
.Replacement.Text = "^&"
.Forward = True
.Wrap = False
.Format = True
End With
Selection.Find.Execute
' Alt+F is the accelerator key for "Find All";
' change "F" to the appropriate key if you
' don't have an English version (e.g. "h" in German):
SendKeys ("{TAB}{+}%F")
Dialogs(wdDialogEditFind).Display 1

' Clean up:
Selection.Font.Shadow = False
Selection.Find.ClearFormatting
Set myRanges = Nothing
End Sub