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