Форум пользователей Visio

' Переписываем формулы, указывающие на фонт, его размер и стиль
' Таким образом мы убираем наследование формул от мастера
' И только так работает обновление шрифтов (протестировано мною)
Public Function DropRamka(vsoShape As Visio.Shape)
     Dim Shp As Shape
     Dim TmpFormula As String, NmCell As Variant
     Dim ArCellName
     
     ' устанавливаем в шаблоне документа даты-константы, вместо формулы Now
     SetupDocDate vsoShape
     Exit Function
     
     ArCellName = Array("Char.Font", "Char.Size", "Char.Style")
     For Each Shp In vsoShape.Shapes
        'Debug.Print Shp.Name
        If (Shp.Shapes.Count > 0) Then
            DropRamka Shp
        End If
       
        For Each NmCell In ArCellName
            If (Not Shp.Cells(NmCell).IsConstant) Then
                'Debug.Print NmCell & "  " & Shp.Name
                TmpFormula = Shp.Cells(NmCell).Formula
                Shp.Cells(NmCell).FormulaForce = ""
                Shp.Cells(NmCell).FormulaForce = TmpFormula
            End If
        Next
     Next
     
     SetupDocDate vsoShape
End Function