Sub Demo()
Application.ScreenUpdating = False
Dim Shp As Shape, Rng As Range, Tbl As Table, Hght As Single, Wdth As Single
Hght = InchesToPoints(0.5):  Wdth = InchesToPoints(2)
With ActiveDocument
  Set Rng = Selection.Range.Characters.First
  Set Shp = .Shapes.AddShape(Type:=msoShapeRectangularCallout, _
    Left:=Rng.Information(wdHorizontalPositionRelativeToPage), _
    Top:=Rng.Information(wdVerticalPositionRelativeToPage) - Hght, _
    Width:=Wdth, Height:=Hght, Anchor:=Rng)
  Set Tbl = .Tables.Add(Range:=Shp.TextFrame.TextRange, Numrows:=1, NumColumns:=2)
  With Tbl.Cell(1,1).Range
    .Text = "Some text"
    .ParagraphFormat.Alignment = wdAlignParagraphLeft
  End With
  Shp.TextFrame.TextRange.Characters.Last.Font.Hidden = True
End With
Application.ScreenUpdating = True
End Sub