Attribute VB_Name = "Modulo1"
Public Sub AutoSave_View_Scale()

    Call ShowFirstViewScale

End Sub


Public Sub ShowFirstViewScale()

    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    Dim ScaleProp As String
    
    On Error Resume Next
  
    'Find the Scale of the first View on the first Sheet
    ScaleProp = ConvScale(oDrawDoc.Sheets.Item(1).DrawingViews.Item(1).Scale)
    
    'Add a custom property "Scale" with all the view scales
    Dim oPropSet As PropertySet
    
    Set oPropSet = ThisApplication.ActiveDocument.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
    Call oPropSet.Item("FirstViewScale").Delete
    Call oPropSet.Add(ScaleProp, "FirstViewScale")
    
    'Still having some problems that the last property does not update correct
    Call RefreshProperties


End Sub


Function ConvScale(ValScale As Double) As String

If ValScale >= 1 Then
    ConvScale = CStr(ValScale) + ":1"
Else
 '   ConvScale = "1:" + CStr(1 / ValScale)
     ConvScale = "1:" + CStr(Round((1 / ValScale), 1)) ' corretto per decimali scala
End If

End Function


Private Sub RefreshProperties()
    
    Set oPropSet = ThisApplication.ActiveDocument.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
    Call oPropSet.Add("", "MyDummy")
    oPropSet.Item("MyDummy").Delete

End Sub