quote:

---

'этот скрипт заменяет простые линии на сматршейп нужный
Private Sub Document_ShapeAdded(ByVal vsoShape As Visio.IVShape)

geom_c = vsoShape.GeometryCount 'число секций
geom1_r = vsoShape.RowCount(visSectionFirstComponent) 'рядов в секции


If Not ActivePage.name = "исх. схема" Then Exit Sub

Dim vsoMaster As Visio.Master
Set vsoMaster = vsoShape.Master

Dim vsoPage As Visio.Page

Dim vsoBegX As Object
Dim vsoBegY As Object
Dim vsoEndX As Object
Dim vsoEndY As Object
Dim vsoWidth As Object

Dim strBowCell As String
Dim strBowFormula As String
Dim intIndex As Integer
Dim intCounter As Integer
Dim vsoLine As Object

'Set vsoCell to the Scratch.X1 cell and set its formula.
Set vsoBegX = vsoShape.Cells("BeginX")
Set vsoBegY = vsoShape.Cells("BeginY")
Set vsoEndX = vsoShape.Cells("EndX")
Set vsoEndY = vsoShape.Cells("EndY")
Set vsoWidth = vsoShape.Cells("Width")
Set vsoWidth = vsoShape.Cells("Width")

If geom_c = 1 And geom1_r = 3 Then 'линия
' vsoShape.CellsSRC(visSectionObject, visRowXForm1D, vis1DBeginX).FormulaU = vsoBegX & " mm"
' Set vsoLine = Drop(ActiveDocument.Masters.ItemU("line"), 0, 0)
Set vsoLine = Application.ActiveWindow.Page.Drop(ActiveDocument.Masters.ItemU("lineP2"), 0, 0)
Debug.Print vsoLine
' expression.Drop(ObjectToDrop, xPos, yPos)
vsoLine.CellsSRC(visSectionObject, visRowXForm1D, vis1DBeginX).FormulaU = vsoBegX
vsoLine.CellsSRC(visSectionObject, visRowXForm1D, vis1DBeginY).FormulaU = vsoBegY
vsoLine.CellsSRC(visSectionObject, visRowXForm1D, vis1DEndX).FormulaU = vsoEndX
vsoLine.CellsSRC(visSectionObject, visRowXForm1D, vis1DEndY).FormulaU = vsoEndY

Set vsoConnects = vsoShape.Connects
For intCounter = 1 To vsoConnects.Count

Set vsoConnect = vsoConnects(intCounter)
Set vsoConnectTo = vsoConnect.ToSheet

' Set Gluecell = vsoLine.CellsSRC(visSectionObject, visRowXForm1D, vis1DBeginX)

' Gluecell.GlueTo vsoConnectTo.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX)
'Print the name of the shape the
'Connect object connects to.
' MsgBox vsoConnectTo

Next intCounter

' MsgBox vsoShape.Connects(0).ToSheet.NameID
'MsgBox "test " & Round(vsoWidth * 25.4, 1)
'Get the Master property of the shape.
vsoShape.Delete
ElseIf Left(vsoShape.name, 2) = "NY" Then
num = GetmaxNum("NY", "_VisDM_NY") + 1
If num <= 7 Then
vsoShape.Cells("Prop._VisDM_NY") = num
If num = 1 Or num = 7 Then vsoShape.Cells("Prop._VisDM_type") = 1
Debug.Print num
End If
End If


End Sub

---

quote:

---

3. Не лезть в формулу, а присваивать так

---