Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 07-19-2011, 02:29 AM
Peter Denly Peter Denly is offline Callout macro needed - Help please Windows XP Callout macro needed - Help please Office 2007
Novice
Callout macro needed - Help please
 
Join Date: Jul 2011
Posts: 11
Peter Denly is on a distinguished road
Default Callout macro needed - Help please

I have been trying to write a macro to produce a callout. This is to replace an old macro in an old template (made in 1998) which is pasted at the bottom of this thread for reference.

It does not need to be as complicated and basically needs to do the following:

1 User selects text within a paragraph
2 Macro copies selection
3 Styles the selection with Style sheet which creates the callout.

The style sheet 'Callout' produces a reformatted paragraph from the copied text in a frame that is moved to the left of the originial paragraph.

HOW FAR I HAVE GOT SO FAR

This does it for a whole paragraph but not for a text selection. The textbox should not be necessary.

Sub Macro2()
'
' callouttest1 Macro
'
'
Selection.Copy
Selection.CreateTextbox
Selection.Style = ActiveDocument.Styles("Callout")
End Sub

This one copies the text select ok but I cannot work out how to apply the Stylesheet to make the callout. Help please. (I am not a developer)

Sub callouttest()
'
' callouttest2 Macro
'
'
Selection.Copy
Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement _
:=wdFloatOverText, DisplayAsIcon:=False
Selection.Style = ActiveDocument.Styles("Callout")
End Sub

THIS IS THE OLD MACRO - It will not run when moved across to new template and does not need to be as complicated as this.

Sub InsertCallout()
'
' InsertCallout Macro
'
'
On Error GoTo HandleError

ActiveWindow.View.Type = wdPageView
Application.ScreenUpdating = False

Dim strCOText As String
Dim lngCOSize As Long
Dim msg As String
Dim Style As String
Dim Title As String
Dim response As String
Dim FirstLineResult As Boolean
Dim UseSelection As Boolean

UseSelection = True 'default - user has made a selection first
FirstLineResult = FirstLineTest()
strCOText = Selection.Text
strCOText = Trim(strCOText)
lngCOSize = Len(strCOText)

'Verify that selection isn't in an existing callout
If Selection.Frames.Count > 0 Then
MsgBox "You can't create a callout from within another callout" _
+ vbCr + "or framed object", vbOKOnly + vbExclamation, "Cursor in " _
& "callout or frame"
GoTo ExitHere
End If

' Verify that selection isn't in table
If Selection.Information(wdWithInTable) Then
MsgBox "Sorry, but callouts can't be created from within " _
+ vbCr + "tables. If you wish to use table text as your " _
& "callout's" + vbCr + "source:" + vbCr + vbCr + "1) Place the cursor " _
& "at the start of the paragraph " + vbCr + "that will serve " _
& "as the callout's anchor." + vbCr + vbCr + "2) Click Insert " _
& "Callout again, followed by OK to " + vbCr + "insert a " _
& "blank callout." + vbCr + vbCr + "3) Manually copy the 'table " _
& "text' to the callout.", vbOKOnly + vbExclamation, "Cursor or " _
& "selection within table"
GoTo ExitHere
End If

'Check the size of the user's selection.
Select Case lngCOSize
Case 0 To 10 'User made no selection
msg = "You've made no selection, or too small a selection." _
+ vbCr + vbCr + "Choose OK to insert a blank callout, " _
& "or the recommended " + vbCr + "Cancel, so that you can go " _
& "back and select your callout's text."
Style = vbOKCancel + vbDefaultButton2 + vbQuestion
Title = "Callout Blowout"
response = MsgBox(msg, Style, Title)
If response = vbOK Then
UseSelection = False 'Insert an empty callout.
GoTo MakeCallout
Else
GoTo ExitHere 'Send them back to make a selection.
End If

Case 11 To 350 'Typical case.
GoTo MakeCallout

Case 351 To 1000 'Selection too big!
msg = "Your selection seems too big for an effective callout. " _
+ vbCr + "Are you sure that you want to continue?"
Style = vbOKCancel + vbDefaultButton2 + vbQuestion
Title = "Size Matters"
response = MsgBox(msg, Style, Title)
If response = vbOK Then
GoTo MakeCallout 'Process anyway.
Else
GoTo ExitHere 'Send them back to change selection.
End If

Case Is > 1000 'Selection far too big
msg = "Your selection is HUGE. Please make an appropriate" + vbCr + _
"selection before using the Insert Callout command."
Style = vbOKOnly + vbCritical
Title = "Size Matters!"
GoTo ExitHere 'Go back Jack.

End Select

MakeCallout:
'Insert a new callout and go to boiler text
Selection.Collapse direction:=wdCollapseStart
ActiveDocument.AttachedTemplate.AutoTextEntries("n ewcallout").Insert _
Where:=Selection.Range, RichText:=True
Selection.Find.ClearFormatting
With Selection.Find
.Text = "This is a sample callout."
.Forward = False
.MatchCase = True
End With
Selection.Find.Execute

'Check for first line and adjust
If FirstLineResult = True Then
With Selection.Frames(1)
.Select
.VerticalPosition = CentimetersToPoints(1)
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
End With
Selection.Find.Execute
End If

'Delete boilertext if selection is being used
If UseSelection = True Then
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.InsertAfter strCOText
Selection.MoveLeft Unit:=wdCharacter, Count:=1
End If

Application.ScreenUpdating = True
Application.ScreenRefresh
MsgBox "A callout has been inserted. Remember to capitalise " _


+ vbCr + "the first letter and add a full stop if " _
& "needed." + vbCr + vbCr + "Also, please remember to press " _
& "and hold the" + vbCr + "Alt and Shift keys before " _
& "moving the callout's frame.", vbOKOnly + vbExclamation, _
"Insert Callout."

ExitHere:
With Selection.Find
.Text = ""
.Forward = True
.MatchCase = False
End With
Exit Sub

HandleError:
MsgBox "Unexpected error. Word says..." + vbCr + vbCr + _
Err.Description + vbCr + vbCr + "Please note the circumstances " _
& "and pass" + vbCr + "the details to the Template Support Team.", _
vbOKOnly + vbExclamation, "Unexpected error."
Resume ExitHere
End Sub
Reply With Quote
  #2  
Old 07-19-2011, 03:34 AM
macropod's Avatar
macropod macropod is offline Callout macro needed - Help please Windows 7 64bit Callout macro needed - Help please Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Peter,

Word hasn't used Style Sheets since the dark ages (well, pre 1994, anyway). Nowadays, everything is based on Styles defined in the document's template and/or created in the document itself.

Some basic code to copy a pargraph, make a callout and paste the copied text into the callout is:
Code:
Dim Shp As Shape
Selection.Paragraphs.First.Range.Copy
Set Shp = ActiveDocument.Shapes.AddCallout(Type:=msoCalloutOne, _
        Left:=100, Top:=40, Width:=150, Height:=75)
Shp.TextFrame.TextRange.PasteAndFormat (wdFormatOriginalFormatting)
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 07-19-2011, 04:26 AM
Peter Denly Peter Denly is offline Callout macro needed - Help please Windows XP Callout macro needed - Help please Office 2007
Novice
Callout macro needed - Help please
 
Join Date: Jul 2011
Posts: 11
Peter Denly is on a distinguished road
Default Callout macro needed - Help please

Many thanks for your help in this problem.

I have tried this out to find - as you say - this code is for making a callout using a whole paragraph.

Is it possible to use part of a paragraph? Only the text selected by the user.

Many thanks

Pete
Reply With Quote
  #4  
Old 07-19-2011, 05:05 AM
macropod's Avatar
macropod macropod is offline Callout macro needed - Help please Windows 7 64bit Callout macro needed - Help please Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Peter,

To copy just the selected text, delete '.Paragraphs.First.Range'. That's all there is to it.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #5  
Old 07-19-2011, 09:03 AM
Peter Denly Peter Denly is offline Callout macro needed - Help please Windows XP Callout macro needed - Help please Office 2007
Novice
Callout macro needed - Help please
 
Join Date: Jul 2011
Posts: 11
Peter Denly is on a distinguished road
Default

Thanks, that just what I needed.

One more - can I style this with a style and have it appear next to the paragraph it comes from rather than at the top of the page?
Reply With Quote
  #6  
Old 07-19-2011, 07:53 PM
macropod's Avatar
macropod macropod is offline Callout macro needed - Help please Windows 7 64bit Callout macro needed - Help please Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Peter,

Try something like:
Code:
Sub Demo()
Dim Shp As Shape, Rng As Range
Set Rng = Selection.Range
Selection.Copy
Selection.Collapse
Set Shp = ActiveDocument.Shapes.AddCallout(Type:=msoCalloutOne, _
        Left:=100, Top:=40, Width:=150, Height:=75)
With Shp.TextFrame.TextRange
  .PasteAndFormat (wdFormatOriginalFormatting)
  .Style = "MyStyle"
End With
With Shp
  .Anchor.Cut
  Selection.Paste
  .WrapFormat.Type = wdWrapSquare
  .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
  .Top = 0
End With
Rng.Select
End Sub
Change 'MyStyle' to suit.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #7  
Old 07-20-2011, 01:44 AM
Peter Denly Peter Denly is offline Callout macro needed - Help please Windows XP Callout macro needed - Help please Office 2007
Novice
Callout macro needed - Help please
 
Join Date: Jul 2011
Posts: 11
Peter Denly is on a distinguished road
Default

Thanks very much for this.

I have just changed 'MyStyle' to 'Normal' to test.

I am getting a Compile error: Expected Function or variable @ .PasteandFormat

I have tried to fix this to no avail - can you help me yet again please?
Reply With Quote
  #8  
Old 07-20-2011, 01:49 AM
macropod's Avatar
macropod macropod is offline Callout macro needed - Help please Windows 7 64bit Callout macro needed - Help please Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Peter,

Try changing:
.PasteAndFormat (wdFormatOriginalFormatting)
to
.Paste
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #9  
Old 07-20-2011, 01:52 AM
Peter Denly Peter Denly is offline Callout macro needed - Help please Windows XP Callout macro needed - Help please Office 2007
Novice
Callout macro needed - Help please
 
Join Date: Jul 2011
Posts: 11
Peter Denly is on a distinguished road
Default

Hi,

I have tried that.

No, throws the same error @ .Paste
Reply With Quote
  #10  
Old 07-20-2011, 02:15 AM
macropod's Avatar
macropod macropod is offline Callout macro needed - Help please Windows 7 64bit Callout macro needed - Help please Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Peter,

In that case, I doubt you have anything selected. You can prevent the error by adding:
If Len(Rng.Text) = 0 Then Exit Sub
after:
Set Rng = Selection.Range
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #11  
Old 07-20-2011, 02:37 AM
Peter Denly Peter Denly is offline Callout macro needed - Help please Windows XP Callout macro needed - Help please Office 2007
Novice
Callout macro needed - Help please
 
Join Date: Jul 2011
Posts: 11
Peter Denly is on a distinguished road
Default

The error is still there. But…

Removed 'With' 'End With' seems to have cured this

This runs ok down to .Anchor.Cut where I now get the error:

Run-time error '424' object required

Any thoughts? Thanks

Current running code:

Code:
Sub Demo2()
'
' Demo2 Macro
'
'
Dim Shp As Shape
Selection.Copy
Set Shp = ActiveDocument.Shapes.AddCallout(Type:=msoCalloutOne, _
Left:=100, Top:=40, Width:=150, Height:=75)
Shp.TextFrame.TextRange.PasteAndFormat (wdFormatOriginalFormatting)
Selection.Style = "Normal"
With Shp
  .Anchor.Cut
  Selection.Paste
  .WrapFormat.Type = wdWrapSquare
  .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
  .Top = 0
End With
Rng.Select
End Sub

Last edited by macropod; 07-20-2011 at 03:10 AM. Reason: Added Code Tags
Reply With Quote
  #12  
Old 07-20-2011, 02:55 AM
macropod's Avatar
macropod macropod is offline Callout macro needed - Help please Windows 7 64bit Callout macro needed - Help please Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Peter,

Removing the 'With' 'End With' and having 'Selection.Style = "Normal"' means the Style gets applied to the document! If you delete the 'With' 'End With', you merely make the code less efficient and you also need to use 'Shp.TextFrame.TextRange.Style = "Normal"'.


I note too that you've deleted the code that defines and sets the Rng variable. That'll cause problems when you get to 'Rng.Select'. Failure to collapse the Selection is also liable to cause problems when you use 'Selection.Paste' after '.Anchor.Cut'.

When you run the unmodified code, per post #6 above, what is selected? Is it text in the body of the document, or something else?
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #13  
Old 07-20-2011, 03:02 AM
Peter Denly Peter Denly is offline Callout macro needed - Help please Windows XP Callout macro needed - Help please Office 2007
Novice
Callout macro needed - Help please
 
Join Date: Jul 2011
Posts: 11
Peter Denly is on a distinguished road
Default

Hi,

As you can see I am not a code writer! I have a single page document running for this test with paragraphs of plain text and I just select some text within a paragraph before applying the macro.
Reply With Quote
  #14  
Old 07-20-2011, 03:09 AM
macropod's Avatar
macropod macropod is offline Callout macro needed - Help please Windows 7 64bit Callout macro needed - Help please Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Peter,

I'm unable to replicate the errors you're getting with either Word 2003 or Word 2010. Try this variant:
Code:
Sub Demo()
Dim Shp As Shape, Rng As Range
Set Rng = Selection.Range
Selection.Copy
Selection.Collapse
Set Shp = ActiveDocument.Shapes.AddCallout(Type:=msoCalloutOne, _
        Left:=100, Top:=40, Width:=150, Height:=75)
With Shp
  .TextFrame.TextRange.PasteSpecial DataType:=wdPasteText
  .Anchor.Cut
  Selection.Paste
  .WrapFormat.Type = wdWrapSquare
  .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
  .Top = 0
End With
Rng.Select
End Sub
Note: Since textboxes default to the 'Normal' Style, pasting as unformatted text should achieve the same result as pasting formatted text then applying the Style.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #15  
Old 07-20-2011, 03:17 AM
Peter Denly Peter Denly is offline Callout macro needed - Help please Windows XP Callout macro needed - Help please Office 2007
Novice
Callout macro needed - Help please
 
Join Date: Jul 2011
Posts: 11
Peter Denly is on a distinguished road
Default

Hi,

I have repasted the original code into the macro and it now works! It is driving me mad!

The new one you have just sent also works ok. Thanks

They both remain at the top of the page rather than with the paragraph they came from? Which would be ideal.

Many thanks - Pete
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Outlook help needed Tricia Outlook 4 06-21-2011 02:56 PM
Needed help with MSI Package ahaseeb Outlook 0 01-17-2011 10:19 PM
AverageIf and Div/0 help needed jim831 Excel 2 10-30-2010 04:54 AM
Callout macro needed - Help please help needed!!! thunder14 Word 1 10-17-2009 02:57 PM
Callout macro needed - Help please Help needed :) thechief55 PowerPoint 1 04-28-2009 01:25 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 05:31 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft