Mniej klikania.
Więcej
projektowania.

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

Dim oRysunek As DrawingDocument = ThisApplication.ActiveDocument
Dim oArkusze As Sheets = oRysunek.Sheets
Dim oArkusz As Sheet
Dim oWidok As DrawingView
Dim Nazwa As String
Dim Sciezka As String

For Each oArkusz In oArkusze
    ' Arkusze bez widoków pomijamy.
    If oArkusz.DrawingViews.Count > 0 Then
        oWidok = oArkusz.DrawingViews.Item(1)
        Sciezka = oWidok.ReferencedDocumentDescriptor.FullDocumentName
        Nazwa = IO.Path.GetFileNameWithoutExtension(Sciezka)
        oArkusz.Name = Nazwa
    End If
Next