Callout macro needed - Help please

[Peter Denly]

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

[macropod]

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:

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)

[Peter Denly]

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

[macropod]

Hi Peter,

To copy just the selected text, delete '.Paragraphs.First.Range'. That's all there is to it.

[Peter Denly]

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?

[macropod]

Hi Peter,

Try something like:

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.

[Peter Denly]

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?

[macropod]

Hi Peter,

Try changing:
.PasteAndFormat (wdFormatOriginalFormatting)
to
.Paste

[Peter Denly]

Hi,

I have tried that.

No, throws the same error @ .Paste

[macropod]

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

[Peter Denly]

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:

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

[macropod]

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?

[Peter Denly]

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.

[macropod]

Hi Peter,

I'm unable to replicate the errors you're getting with either Word 2003 or Word 2010. Try this variant:

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.

[Peter Denly]

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