Dim oDoc As DrawingDocument
oDoc = ThisApplication.ActiveDocument

Dim oArkusz As Sheet
oArkusz = oDoc.ActiveSheet

Dim oWymiar As DrawingDimension
Dim oWymiary As DrawingDimensions
Dim oKolekcjaWymiarow As ObjectCollection

oWymiary = oArkusz.DrawingDimensions
oKolekcjaWymiarow = ThisApplication.TransientObjects.CreateObjectCollection

' Wyrównanie wymiarów liniowych i kątowych na aktywnym arkuszu.
For Each oWymiar In oWymiary
    If TypeOf oWymiar Is LinearGeneralDimension Or _
       TypeOf oWymiar Is AngularGeneralDimension Then
        oWymiar.CenterText
        oKolekcjaWymiarow.Add(oWymiar)
    End If
Next

If oKolekcjaWymiarow.Count > 0 Then
    oWymiary.Arrange(oKolekcjaWymiarow)
End If