Sub ChangeCalloutText() Dim sCallout As Shape Dim sText As Shape Set sCallout = ActiveShape If sCallout Is Nothing Then MsgBox "Nothing selected", vbCritical Exit Sub End If If sCallout.Type <> cdrCustomShape Then Set sCallout = sCallout.Next End If If Not sCallout Is Nothing Then If sCallout.Type = cdrCustomShape Then If sCallout.Custom.TypeID = "Callout" Then Set sText = sCallout.Custom.TextShape End If End If End If If sText Is Nothing Then MsgBox "A callout object must be selected", vbCritical Exit Sub End If sText.Text.Story.Text = "New Text"End Sub