Jay
Thu Dec 09 09:13:40 CST 2004
Hi Greg,
You're right. Of course I did test the macro before I posted it, but I
didn't try it with a file where the last paragraph has the style being
copied. The infinite loop happens when the search keeps finding the final
paragraph mark. Removing the Collapse statement does fix it.
The On Error Resume Next is the correct way to handle the case when the user
cancels the Save dialog.
I don't generally like using an InputBox to get the names of things that
need to be exactly right. It's too easy to get transposed characters, or
missing spaces or extra spaces. Then you get an error message on the .Style
= statement that "the requested member of the collection does not exist". I
thought of replacing the InputBox statement with this:
With Dialogs(wdDialogFormatStyle)
If .Display = -1 Then
NamedStyle = .Name
Else
Exit Sub
End If
End With
Unfortunately, although .Display (as opposed to .Show) is supposed to
display the dialog without executing any of its functions, in this case it
still allows the user to modify the style or define a new style. This is
unacceptable. For a professional-quality macro, you'd have to design a
userform containing a listbox, which you'd initialize with the names of the
available styles, and which would return just the name of the selected
style. A second but inferior choice would be to error-trap the .Style =
statement, using an error-handler that displays a message box.
--
Regards,
Jay Freedman
Microsoft Word MVP FAQ:
http://word.mvps.org
Greg Maxey wrote:
> Jay,
>
> I reviewed and tested your code and found it would loop continously.
> I isoloated the cause to the following line in the Do Loop and
> removed it:
>
>> SrcRg.Collapse wdCollapseEnd
>
> I also notice a error was generated if I didn't save the new
> document. I am not very savvy on hanling errors, but I add an on
> error resume next line. Is the the correct way. I also added a user
> input to name the style.
>
> Sub CopyAllDesignatedStyle()
> Dim NamedStyle As String
> Dim NewDoc As Document
> Dim SrcRg As Range, DestRg As Range
>
> Set SrcRg = ActiveDocument.Range
> NamedStyle = InputBox("Type the style name to copy(e.g., Body Text)",
> _ "Named Style")
> Set NewDoc = Documents.Add
> With SrcRg.Find
> .ClearFormatting
> .Text = ""
> .Format = True
> .Style = ActiveDocument.Styles(NamedStyle)
> .Forward = True
> .Wrap = wdFindStop
> Do While .Execute
> Set DestRg = NewDoc.Range
> DestRg.Collapse wdCollapseEnd
> DestRg.FormattedText = SrcRg.FormattedText
> 'SrcRg.Collapse wdCollapseEnd
> Loop
> End With
>
> On Error Resume Next
> NewDoc.Save
> Set SrcRg = Nothing
> Set DestRg = Nothing
> Set NewDoc = Nothing
> End Sub
>
>
>
> Jay Freedman wrote:
>> On Wed, 8 Dec 2004 17:59:02 -0800, "Scott VA" <Scott
>> VA@discussions.microsoft.com> wrote:
>>
>>> I am trying to write a macro in WORD to select all text of a
>>> particular style,, copy it and paste it into a new document. I can
>>> do it manually, but the record macro will not recognize either the
>>> "select all" using the Style pane or using the "highlight all'" in
>>> the find dialog box. Any help is apprecaited.
>>
>> Hi Scott,
>>
>> Selecting and manipulating multiple areas of text is one of many
>> recent features that have never been supported in VBA. There is
>> simply no way to program a macro to do what you can do manually.
>>
>> However, you can program a macro that accomplishes the same final
>> result by copying one piece at a time in a loop, like this:
>>
>> Sub CopyAllBodyText()
>> Dim NewDoc As Document
>> Dim SrcRg As Range, DestRg As Range
>>
>> Set SrcRg = ActiveDocument.Range
>>
>> Set NewDoc = Documents.Add
>>
>> With SrcRg.Find
>> .ClearFormatting
>> .Text = ""
>> .Format = True
>> .Style = ActiveDocument.Styles("Body Text")
>> .Forward = True
>> .Wrap = wdFindStop
>>
>> Do While .Execute
>> 'when a piece of Body Text is found,
>> 'SrcRg covers its range
>> Set DestRg = NewDoc.Range
>> DestRg.Collapse wdCollapseEnd
>> DestRg.FormattedText = SrcRg.FormattedText
>> SrcRg.Collapse wdCollapseEnd
>> Loop
>> End With
>>
>> NewDoc.Save 'will display Save dialog
>>
>> Set SrcRg = Nothing
>> Set DestRg = Nothing
>> Set NewDoc = Nothing
>> End Sub
>>
>> Also notice how the piece of text is transferred between the two
>> ranges by assigning the .FormattedText property. This doesn't use the
>> clipboard, so it doesn't zap anything the user may already have put
>> there, plus it's faster.