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