Вот у коллеги поинтересуйтесь ...если ли макрос определения размеров фигуры
Sub razmer()
    ActiveDocument.Unit = cdrMillimeter
    Set OrigSelection = ActiveSelectionRange
    For Each s2 In OrigSelection
        Dim sh As ShapeRange, w#, h#, s As Shape
        Dim x As Double, y As Double
        s2.GetSize w, h
        
        Set s = ActiveDocument.ActiveLayer.CreateArtisticText(s2.LeftX, s2.TopY + 2, h & " x " & w & " mm")
        
        s.Fill.UniformColor.CopyAssign s2.Outline.Color
    Next s2
End Sub
	а что прописать чтобы текст также дублировался снизу?Вот примерно так
Код:Sub razmer() ActiveDocument.Unit = cdrMillimeter Set OrigSelection = ActiveSelectionRange For Each s2 In OrigSelection Dim sh As ShapeRange, w#, h#, s As Shape Dim x As Double, y As Double s2.GetSize w, h Set s = ActiveDocument.ActiveLayer.CreateArtisticText(s2.LeftX, s2.TopY + 2, h & " x " & w & " mm") s.Fill.UniformColor.CopyAssign s2.Outline.Color Next s2 End Sub
Set s = ActiveDocument.ActiveLayer.CreateArtisticText(s2.LeftX, s2.BottomY + 2, h & " x " & w & " mm")
      
s.Fill.UniformColor.CopyAssign s2.Outline.Color