FixCELLS.md

Лечение "пятого колеса" в трафарете от immortal

Dim mSh As Shape, subSH As Shape, cln As String, clv As String
Sub bvv()
Set mSh = ActivePage.Shapes(1)
For Each subSH In mSh.Shapes
    If subSH.Type = visTypeShape Then FixFormula subSH
Next
MsgBox "TheEnd!!!"
End Sub

Sub FixFormula(obj As Shape)
    If obj.CellExists("Fields.Value", visExistsAnywhere) Then
        Debug.Print obj.Name, obj.Cells("Fields.Value").Formula
        cln = Mid(obj.Cells("Fields.Value").Formula, 9, 100)
        If Len(cln) > 0 And InStr(cln, mSh.NameID) = 0 And InStr(cln, "Prop.") <> 1 Then clv = mSh.Cells(cln).Formula: clv = Replace(clv, "Prop.", mSh.NameID & "!Prop."): clv = Replace(clv, ";", ","): _
        If Len(clv) <> 2 And InStr(clv, """""") = 0 Then obj.Cells("Fields.Value").Formula = clv
    End If
End Sub

FixStencil.md

Правка локально сохраненного документа imm_stamp.vssm. В дальнейшем использовать данную версию трафарета!

Dim mSh As Shape, subSH As Shape, cln As String, clv As String
Dim mst As Master, sd As Document, dn As String
Sub bvv()
dn = "C:\Users\surrogate\Downloads\imm_stamp.vssm" ' путь к сохраненному трафарету
Set sd = Documents.OpenEx(dn, visOpenDocked + visOpenRW) ' открыть трафарет для редактирования
Set mst = sd.Masters("Основная надпись ф3") ' определить мастер
Set mSh = mst.Shapes(1) ' определить основную фигуру мастера
For Each subSH In mSh.Shapes ' перебор фигур внутри местера
    If subSH.Type = visTypeShape Then FixFormula subSH ' запуск процедуры редактирования формул
Next
sd.Save ' сохранить трафарет 
sd.Close ' закрыть трафарет
MsgBox "TheEnd!!!"
End Sub

Sub FixFormula(obj As Shape)
    If obj.CellExists("Fields.Value", visExistsAnywhere) Then ' проверка наличия поля 
        Debug.Print obj.Name, obj.Cells("Fields.Value").Formula
        cln = Mid(obj.Cells("Fields.Value").Formula, 9, 100) '
        If Len(cln) > 0 And InStr(cln, mSh.NameID) = 0 And InStr(cln, "Prop.") <> 1 Then clv = mSh.Cells(cln).Formula: clv = Replace(clv, "Prop.", mSh.NameID & "!Prop."): clv = Replace(clv, ";", ","): _
        If Len(clv) <> 2 And InStr(clv, """""") = 0 Then obj.Cells("Fields.Value").Formula = clv
    End If
End Sub