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