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

Форум по вопросам применения и программирования в Visio
Текущее время: 28 мар 2024, 12:46

Часовой пояс: UTC + 3 часа [ Летнее время ]


Правила форума


При размещении файлов предпочтительным является формат vsd (а не vsdx/vsdm)
Размещая ваши вложения на форуме не используйте имена файлов содержащих кириллицу, в противном случае файл будет иметь имя .<расширение файла> !

Для форматирования ваших сообщений используйте BBCodes, описание используемых на форуме BBCodes.



Начать новую тему Ответить на тему  [ Сообщений: 100 ]  На страницу Пред.  1, 2, 3, 4, 5  След.
Автор Сообщение
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 27 авг 2018, 16:43 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 2253
Очков репутации: 100626

Добавить очки репутацииУменьшить очки репутации
А так?
.Worksheets(1).Range("B2").End(xlDown).Row


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 28 авг 2018, 09:27 
Не в сети
Новичок

Зарегистрирован: 19 мар 2018, 14:10
Сообщений: 45
Использую Visio c: 2010
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Tumanov писал(а):
А так?
.Worksheets(1).Range("B2").End(xlDown).Row


да, работает..
однако столбец "B" содержит объеденные ячейки, доходя до первой из них - прекращает "подсчет"..
Результат = 11
по факту = 1072


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 28 авг 2018, 09:41 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 2253
Очков репутации: 100626

Добавить очки репутацииУменьшить очки репутации
Объединенные ячейки - это зло для автоматизации. Как будто сломанная таблица.
Нужно исправлять. Например, делать (промежуточный) новый лист, в котором будут видны только корректные данные.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 28 авг 2018, 13:40 
Не в сети
Новичок

Зарегистрирован: 19 мар 2018, 14:10
Сообщений: 45
Использую Visio c: 2010
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Tumanov писал(а):
Объединенные ячейки - это зло для автоматизации. Как будто сломанная таблица.
Нужно исправлять. Например, делать (промежуточный) новый лист, в котором будут видны только корректные данные.

Так то да.
Вот только эти данные берутся из экспорта из другого приложения, и изначально предполагалось, что файл будет передан в visio без изменений.
С другой стороны, я могу посчитать длину массива на основе этих данных, и из длины получить номер последней ячейки.
Пока печатал данное сообщение, на ум пришло..))


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 05 сен 2018, 11:14 
Не в сети
Новичок

Зарегистрирован: 19 мар 2018, 14:10
Сообщений: 45
Использую Visio c: 2010
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Получилось, по мне так, вполне сносно..))
Вот так это выглядит:
Встроенное видео спрятано под спойлер ↓ Прямая ссылка на видео
Спойлер:
phpBB [media]

Код:
Код:
Option Explicit

Dim textLengthHostName, textLengthIP, textLength

Const Inch As Double = 25.4
Dim ArrayBS As Variant
Dim BSName As String
Dim NameTR, TypeTR, ModelTR As String
Dim NameBSU, IPBSU, NameSU, IPSU, VendorWiMax As String
Dim NameSwitchBS, IPSwitchBS, VendorSwitchBS As String
Dim NameSwitchClient, IPSwitchClient, VendorSwitchClient As String
Dim ShapeChrs
Dim ChekingFields As Boolean

Private Sub Data_from_Excel()
Dim oWorkbook As Excel.Workbook
Dim lastRow
lastRow = 1072
On Error Resume Next
Set oWorkbook = GetObject("D:\Разные отчеты IT\BS_data_from_MC.xlsx")
With oWorkbook
    ArrayBS = .Worksheets(1).Range("B2:D" & lastRow).Value
End With
Set oWorkbook = Nothing

End Sub

Private Sub TypePMComboBox_Change()
    If TypePMComboBox.Value = "ВОЛС" Or TypePMComboBox.Value = "UTP" Or TypePMComboBox.Value = "РРЛ" Then
        BSUCheckBox.Enabled = False
        BSUCheckBox.BackColor = &H80000004
        BSUNameTextBox.Enabled = False
        BSUNameTextBox.BackColor = &H80000004
        BSUIPTextBox.Enabled = False
        BSUIPTextBox.BackColor = &H80000004
        SUCheckBox.Enabled = False
        SUCheckBox.BackColor = &H80000004
        SUNameTextBox.Enabled = False
        SUNameTextBox.BackColor = &H80000004
        SUIPTextBox.Enabled = False
        SUIPTextBox.BackColor = &H80000004
        WiMaxVendorComboBox.Enabled = False
        WiMaxVendorComboBox.BackColor = &H80000004
    End If
    If TypePMComboBox.Value = "WiMax" Then
        BSUCheckBox.Enabled = True
        BSUCheckBox.BackColor = &H8000000F
        BSUNameTextBox.Enabled = True
        BSUNameTextBox.BackColor = &H80000005
        BSUIPTextBox.Enabled = True
        BSUIPTextBox.BackColor = &H80000005
        SUCheckBox.Enabled = True
        SUCheckBox.BackColor = &H8000000F
        SUNameTextBox.Enabled = True
        SUNameTextBox.BackColor = &H80000005
        SUIPTextBox.Enabled = True
        SUIPTextBox.BackColor = &H80000005
        WiMaxVendorComboBox.Enabled = True
        WiMaxVendorComboBox.BackColor = &H80000005
    End If
End Sub

Private Sub UserForm_Initialize()
    Dim i, k As Integer
    TypePMComboBox.List = Array("WiMax", "ВОЛС", "UTP", "РРЛ")
    TRTypeComboBox.List = Array("PTN", "RTN", "ASR", "ipaso")
    WiMaxVendorComboBox.List = Array("Proxim", "Infinet")
    switchBSVendorComboBox.List = Array("Huawei", "Raisecom", "Qtech", "RAD", "Cisco")
    switchClientVendorComboBox.List = Array("Huawei", "Raisecom", "Qtech", "RAD", "Cisco")
    ClientServiceComboBox.List = Array("Internet", "L3VPN", "L2VPN", "E1")
   
'    On Error Resume Next
'    BSNameComboBox.List = GetObject("D:\Разные отчеты IT\BS_data_from_MC.xlsx").Worksheets(1).Range("B2:B1072").Value
'    Workbooks("D:\Разные отчеты IT\BS_data_from_MC.xlsx").Close SaveChanges:=False
   
    Call Data_from_Excel
    For i = 1 To UBound(ArrayBS)
        BSNameComboBox.AddItem ArrayBS(i, 1)
        BSNumComboBox.AddItem ArrayBS(i, 3)
    Next i
'    MsgBox BSNameComboBox.ListCount & " " & BSNumComboBox.ListCount
End Sub

Private Sub BSNameComboBox_Change()
Dim i As Integer
    For i = 1 To UBound(ArrayBS)
       If ArrayBS(i, 1) = BSNameComboBox.Value Then
       BSNumComboBox.Value = ArrayBS(i, 3)
    End If
Next i

End Sub

Private Sub BSNumComboBox_Change()
Dim i As Integer
    For i = 1 To UBound(ArrayBS)
       If ArrayBS(i, 3) = BSNumComboBox.Value Then
       BSNameComboBox.Value = ArrayBS(i, 1)
    End If
Next i

End Sub
Private Sub NewBS_Initialize()
    Dim shBS, shCountur As Visio.Shape
    Set shBS = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("BS NAME"), 104.3 / Inch, 97.5 / Inch)
    Set shCountur = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("Countur"), 81.05 / Inch, 95 / Inch)
    With shBS
        .Text = "БС " & Chr(171) & BSNameComboBox.Value & Chr(187)
        'Заполняем данные фигуры:
        .Cells("Prop.ШПД_БС_название.Value").Formula = Chr(34) & BSNameComboBox & Chr(34)
        .Cells("Prop.ШПД_БС_номер.Value").Formula = BSNumComboBox.Value
'        .Cells("Prop.ШПД_БС_адрес.Value").Formula = Chr(34) & TypePMComboBox.Value & Chr(34)
'        .Cells("Prop.ШПД_БС_допуск.Value").Formula = Chr(34) & ClientServiceComboBox.Value & Chr(34)
    End With
End Sub
Private Sub TR_Initialize()
    Dim sh As Visio.Shape
   
    If TRTypeComboBox.Value = "PTN" Then Set sh = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("PTN"), 60 / Inch, 94 / Inch)
    If TRTypeComboBox.Value = "RTN" Then Set sh = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("RTN"), 60 / Inch, 94 / Inch)
    If TRTypeComboBox.Value = "ASR" Then
        If TRIPTextBox.Value = "" Then
            MsgBox "Не заполнено поле ""IP TR"""
        Exit Sub
        End If
        Set sh = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("ASR"), 60 / Inch, 94 / Inch)
    End If
    If TRTypeComboBox.Value = "ipaso" Then
        If TRIPTextBox.Value = "" Then
            MsgBox "Не заполнено поле ""IP TR"""
        Exit Sub
        End If
        Set sh = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("Ipaso"), 60 / Inch, 94 / Inch)
    End If
    With sh
        'Вставляем в текст фигуры многострочный текст:
        If TRIPTextBox.Value = "" Then
            .Text = TRNameTextBox.Value & Chr(10) & TRModelComboBox.Value
        Else
            .Text = TRNameTextBox.Value & Chr(10) & TRIPTextBox
        End If
        .Characters.CharProps(visCharacterSize) = 5
        .Cells("Prop.Network_Name.Value").Formula = """" & TRNameTextBox.Value & """"
        .Cells("Prop.IP_address.Value").Formula = Chr(34) & TRIPTextBox & Chr(34)
        .Cells("Prop.BS_num.Value").Formula = BSNumComboBox.Value
         
    End With
   
End Sub
Private Sub TRTypeComboBox_Change()
    If TRTypeComboBox.Value = "PTN" Then
        TRModelComboBox.Value = ""
        TRModelComboBox.List = Array("PTN1900", "PTN950", "PTN3900")
    End If
    If TRTypeComboBox.Value = "RTN" Then
        TRModelComboBox.Value = ""
        TRModelComboBox.List = Array("RTN905", "RTN910", "RTN950")
    End If
    If TRTypeComboBox.Value = "ASR" Then
        TRModelComboBox.Value = ""
        TRModelComboBox.List = Array("ASR910", "ASR920", "ASR9006", "ASR9010")
    End If
    If TRTypeComboBox.Value = "ipaso" Then
        TRModelComboBox.Clear
        TRModelComboBox.Value = "iPASOLINK"

    End If
   
End Sub
Private Sub BSU_Initialize()
    Dim sh As Visio.Shape
    Dim textLength As Integer

    textLengthHostName = Len(BSUNameTextBox.Value)
    textLengthIP = Len(BSUIPTextBox.Value)
    If WiMaxVendorComboBox.Value = "Proxim" Then Set sh = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("Proxim"), 87 / Inch, 95 / Inch)
    If WiMaxVendorComboBox.Value = "Infinet" Then Set sh = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("Infinet"), 87 / Inch, 95 / Inch)
    With sh
        'Вставляем в текст фигуры многострочный текст:
        .Text = BSUNameTextBox.Value & Chr(10) & BSUIPTextBox.Value
        textLength = Len(sh.Text)
        'Здесь делаем IP  адрес в тексте "полужирным" с размером шрифта 5:
        Set ShapeChrs = sh.Characters
        ShapeChrs.Begin = textLengthHostName + 1
        ShapeChrs.End = textLength
        ShapeChrs.CharProps(visCharacterStyle) = visBold
        ShapeChrs.CharProps(visCharacterSize) = 5
        'Заполняем данные фигуры:
        .Cells("Prop.Network_Name.Value").Formula = """" & BSUNameTextBox.Value & """"
        .Cells("Prop.IP_address.Value").Formula = Chr(34) & BSUIPTextBox.Value & Chr(34)
        .Cells("Prop.BS_num.Value").Formula = BSNumComboBox.Value
        .Cells("Prop.Place.Value").Formula = Chr(34) & "БС" & Chr(34)
        .Cells("Prop.Type.Value").Formula = Chr(34) & "BSU" & Chr(34)
        .Cells("Prop.Parent.Value").Formula = Chr(34) & TRNameTextBox.Value & Chr(34)
        'Гиперссылка:
        .Hyperlinks.Add.Address = "https://" & BSUIPTextBox
         
    End With
     
End Sub
Private Sub SU_Initialize()
    Dim sh, shWirelessLink As Visio.Shape
    Dim textLength As Integer

    textLengthHostName = Len(SUNameTextBox.Value)
    textLengthIP = Len(SUIPTextBox.Value)
    If WiMaxVendorComboBox.Value = "Proxim" Then Set sh = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("Proxim"), 138 / Inch, 95 / Inch)
    If WiMaxVendorComboBox.Value = "Infinet" Then Set sh = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("Infinet"), 138 / Inch, 95 / Inch)
    With sh
        'Вставляем в текст фигуры многострочный текст:
        .Text = SUNameTextBox.Value & Chr(10) & SUIPTextBox.Value
        textLength = Len(sh.Text)
        'Здесь делаем IP  адрес в тексте "полужирным" с размером шрифта 5:
        Set ShapeChrs = sh.Characters
        ShapeChrs.Begin = textLengthHostName + 1
        ShapeChrs.End = textLength
        ShapeChrs.CharProps(visCharacterStyle) = visBold
        ShapeChrs.CharProps(visCharacterSize) = 5
        'Заполняем данные фигуры:
        .Cells("Prop.Network_Name.Value").Formula = """" & SUNameTextBox.Value & """"
        .Cells("Prop.IP_address.Value").Formula = Chr(34) & SUIPTextBox.Value & Chr(34)
        .Cells("Prop.BS_num.Value").Formula = BSNumComboBox.Value
        .Cells("Prop.Place.Value").Formula = Chr(34) & "Клиент" & Chr(34)
        .Cells("Prop.Type.Value").Formula = Chr(34) & "SU" & Chr(34)
        .Cells("Prop.Parent.Value").Formula = Chr(34) & BSUNameTextBox.Value & Chr(34)
        'Гиперссылка:
        .Hyperlinks.Add.Address = "https://" & SUIPTextBox
     End With
     Set shWirelessLink = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("Wireless Link"), 117 / Inch, 93 / Inch)
     
End Sub
Private Sub Client_Initialize()
    Dim shAddress, shClient, shCountur As Visio.Shape

    Set shAddress = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("Address"), 179.3415 / Inch, 97.5 / Inch)
    Set shClient = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("Client Description"), 179.3415 / Inch, 92.5 / Inch)
    Set shCountur = ActivePage.Drop(Application.Documents.Item("ШПД_.vssx").Masters.Item("Countur"), 156.05 / Inch, 95 / Inch)
    With shClient
        If ClientServiceComboBox.Value = "L2VPN" Then
            .Text = ClientNameTextBox.Value & Chr(10) & "vlan" & Chr(32) & ClientVlanTextBox.Value & Chr(44) & Chr(32) & ClientServiceComboBox.Value
        Else
            .Text = ClientNameTextBox.Value & Chr(10) & "vlan" & Chr(32) & ClientVlanTextBox.Value & Chr(44) & Chr(32) & ClientNetTextBox.Value
        End If
       
        'Заполняем данные фигуры:
        .Cells("Prop.ШПД_vlan.Value").Formula = ClientVlanTextBox.Value
        .Cells("Prop.ШПД_Адрес.Value").Formula = Chr(34) & ClientAddressTextBox.Value & Chr(34)
        .Cells("Prop.ШПД_БС.Value").Formula = Chr(34) & BSNameComboBox & Chr(34)
        .Cells("Prop.ШПД_Клиент.Value").Formula = Chr(34) & ClientNameTextBox.Value & Chr(34)
        .Cells("Prop.ШПД_БС_номер.Value").Formula = BSNumComboBox.Value
        .Cells("Prop.ШПД_ПМ.Value").Formula = Chr(34) & TypePMComboBox.Value & Chr(34)
        .Cells("Prop.ШПД_Услуга.Value").Formula = Chr(34) & ClientServiceComboBox.Value & Chr(34)
        .Cells("Prop.ШПД_Родитель.Value").Formula = Chr(34) & SUNameTextBox.Value & Chr(34)
        .Characters.CharProps(visCharacterSize) = 5
    End With
    shAddress.Text = ClientAddressTextBox.Value

     
End Sub
Private Sub Start_Draw()
    If NewBSCheckBox = True Then Call NewBS_Initialize
    If TRCheckBox = True Then Call TR_Initialize
    If BSUCheckBox = True Then Call BSU_Initialize
    If SUCheckBox = True Then Call SU_Initialize
    Call Client_Initialize
End Sub
Private Sub CheckFields()
    ChekingFields = False
    If TypePMComboBox.Value = "" Then
        MsgBox "Не заполнено поле ""Тип ПМ"""
        Exit Sub
    End If
    If BSNameComboBox.Value = "" Or BSNumComboBox.Value = "" Then
        MsgBox "Не заполнено поле ""БС"""
        Exit Sub
    End If

    If TRCheckBox = True And (TRNameTextBox.Value = "" Or TRTypeComboBox.Value = "" Or TRModelComboBox.Value = "") Then
        MsgBox "Не заполнено поле ""TR"""
        Exit Sub
    End If
    If BSUCheckBox = True Then
        If BSUNameTextBox.Value = "" Or BSUIPTextBox.Value = "" Then
            MsgBox "Не заполнено поле ""BSU"""
            Exit Sub
        End If
        If WiMaxVendorComboBox.Value = "" Then
                MsgBox "Не заполнено поле ""Вендор WiMax"""
            Exit Sub
        End If
        If TRNameTextBox.Value = "" Then
            MsgBox "Не заполнено поле ""Имя TR (Родитель)"""
            Exit Sub
        End If
    End If
    If SUCheckBox = True Then
        If SUNameTextBox.Value = "" Or SUIPTextBox.Value = "" Then
            MsgBox "Не заполнено поле ""SU"""
            Exit Sub
        End If
        If WiMaxVendorComboBox.Value = "" Then
                MsgBox "Не заполнено поле ""Вендор WiMax"""
            Exit Sub
        End If
        If BSUNameTextBox.Value = "" Then
            MsgBox "Не заполнено поле ""Имя BSU (Родитель)"""
            Exit Sub
        End If
    End If
        If ClientServiceComboBox.Value = "" Then
        MsgBox "Не заполнено поле ""Тип Услуги"""
        Exit Sub
    End If
    If ClientVlanTextBox.Value = "" Then
        MsgBox "Не заполнено поле ""Vlan"""
        Exit Sub
    End If
    If ClientNameTextBox.Value = "" Or ClientAddressTextBox.Value = "" Then
            MsgBox "Не заполнены поля ""Имя и Адрес клиента"""
        Exit Sub
    End If
    If SUNameTextBox.Value = "" Then
        MsgBox "Не заполнено поле ""Имя (Родитель)"""
        Exit Sub
    End If
    If (ClientServiceComboBox.Value = "Internet" Or ClientServiceComboBox.Value = "L3VPN") And ClientNetTextBox.Value = "" Then
        MsgBox "Не заполнено поле ""Подсеть клиента"""
        Exit Sub
    End If
    ChekingFields = True
   
End Sub
Private Sub DrawCommandButton_Click()
    Call CheckFields
    If ChekingFields = True Then
        If NewBSCheckBox = True Then Call NewBS_Initialize
        If TRCheckBox = True Then Call TR_Initialize
        If BSUCheckBox = True Then Call BSU_Initialize
        If SUCheckBox = True Then Call SU_Initialize
        Call Client_Initialize
    End If
End Sub
Private Sub ClearCommandButton_Click()
     Dim C, V As Control
    For Each C In DataForDraw_v2.Controls
        If TypeName(C) = "TextBox" Or TypeName(C) = "ComboBox" Then
            C.Value = ""
        End If
    Next C
    For Each V In DataForDraw_v2.Controls
        If TypeName(V) = "CheckBox" Then
            V.Value = False
        End If
    Next V

End Sub


Если более опытные программеры подскажут, что можно усовершенствовать - буду рад 8-)
Ну и осталось еще нарисовать соединительные линии, я так и не понял пока как соединить определенные точки соединения определенной фигуры с другой точкой другой фигуры.
А также есть недоработка по scroll в ComboBox через ролик Мыши.
Если по данному поводу наведете на мысль - будет здорово :roll:


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 05 сен 2018, 12:10 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 2253
Очков репутации: 100626

Добавить очки репутацииУменьшить очки репутации
Цитата:
Ну и осталось еще нарисовать соединительные линии, я так и не понял пока как соединить определенные точки соединения определенной фигуры с другой точкой другой фигуры.

Для соединения можно использовать метод AutoConnect объекта Shape или методы GlueTo, GlueToPos объекта Cell.
Для AutoConnect нужны два шейпа. Он соединяет их динамическим коннектором, то есть не привязываясь к конкретной точке.
Для GlueTo нужно выбрать ячейки. Например, чтобы соединить ConnectionPoint одного шейпа с EndX коннектора выбирают vso2DShape1.Cells("Connections.X1") и vso1DShape.Cells("EndX") - это из примера в документации. В этом случае GlueTo соединит один конец коннектора с первой ConnectionPoint шейпа.
Для второго конца коннектора выполняется такая же операция для других ячеек.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 05 сен 2018, 12:18 
На форуме есть полезный раздел, в нем была ветка про коннекторы


Пожаловаться на это сообщение
Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 05 сен 2018, 15:40 
Не в сети
Новичок

Зарегистрирован: 19 мар 2018, 14:10
Сообщений: 45
Использую Visio c: 2010
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Tumanov писал(а):
Для GlueTo нужно выбрать ячейки. Например, чтобы соединить ConnectionPoint одного шейпа с EndX коннектора выбирают vso2DShape1.Cells("Connections.X1") и vso1DShape.Cells("EndX") - это из примера в документации. В этом случае GlueTo соединит один конец коннектора с первой ConnectionPoint шейпа.
Для второго конца коннектора выполняется такая же операция для других ячеек.

Честно пытался самостоятельно разобраться, но туплю
Вот у меня есть фигура, в таблице свойств которой, среди прочего, фигурируют точки соединения:
Изображение
каким образом можно соединить одну из этих точек с аналогичной точкой другой фигуры?


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 05 сен 2018, 15:55 
Shishok в сообщении #9899 писал(а):
Код:
Sub ShapeGlue()
Dim shp1 As Visio.Shape, shp2 As Visio.Shape
    Set shp1 = ActiveWindow.Selection(1)
    Set shp2 = ActiveWindow.Selection(2)
    shp1.CellsU("EndX").GlueTo shp2.CellsSRC(1, 1, 0) ' конец коннектора/линии к шейпу
    shp1.Cells("EndX").GlueTo shp2.Cells("Connections.X1") ' конец коннектора/линии к точке соединения шейпа (это лучше)
End Sub
или так
Tumanov в сообщении #9901 писал(а):
Лучше всего клеить Connection Points-ами. Причем нужно помнить, что они должны быть разными и клеить которые "наружу" к тем, которые "внутрь".
Вот запись макроса
Код:
    Set vsoCell3 = Application.ActiveWindow.Page.Shapes.ItemFromID(2).CellsSRC(visSectionConnectionPts, 0, 0)
    Set vsoCell4 = Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionConnectionPts, 0, 0)
    vsoCell3.GlueTo vsoCell4



Пожаловаться на это сообщение
Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 05 сен 2018, 17:47 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 2253
Очков репутации: 100626

Добавить очки репутацииУменьшить очки репутации
Пример файла
В этом примере Connection Points у прямоугольников именованные. В данном случае это удобнее, чем строки пересчитывать. Причем они разного типа. Наоборот - не приклеится.


Вложения:
dd1.gif
dd1.gif [ 37.41 Кб | Просмотров: 976 ]
dd1.vsd [23.5 Кб]
Скачиваний: 122
Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 06 сен 2018, 11:36 
Не в сети
Новичок

Зарегистрирован: 19 мар 2018, 14:10
Сообщений: 45
Использую Visio c: 2010
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
спасибо, буду пробовать
а саму линию то каким образом лучше нанести на схему?
при записи макроса получается так:
Код:
Application.ActiveWindow.Page.Drop Application.Documents.item("D:\Разные отчеты IT\Схемы\в Visio\Test_auto_draw_VBA_v2.vsdm").Masters.ItemU("Dynamic connector"), 0#, 0#


на сайте MS в примере с GlueTo описано так:
Код:
Set vso1DShape = ActivePage.DrawLine(3, 5, 5, 3) 


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 06 сен 2018, 12:06 
Hamit писал(а):
саму линию то каким образом лучше нанести на схему?
при записи макроса получается так
макрорекордер записал добавление динамической соединительной линии (коннектора). Вам что нужно коннектор или линию ?


Пожаловаться на это сообщение
Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 06 сен 2018, 13:18 
Не в сети
Новичок

Зарегистрирован: 19 мар 2018, 14:10
Сообщений: 45
Использую Visio c: 2010
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Гость писал(а):
Hamit писал(а):
саму линию то каким образом лучше нанести на схему?
при записи макроса получается так
макрорекордер записал добавление динамической соединительной линии (коннектора). Вам что нужно коннектор или линию ?

то, что в Visio называется "Соединительная линия"..))


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 06 сен 2018, 13:31 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 2253
Очков репутации: 100626

Добавить очки репутацииУменьшить очки репутации
Значит нужно пользоваться тем, что записал macrorecorder. Только подсократить лишнее. Получится примерно так
Код:
Set ConnectorShape = ActivePage.Drop (Masters.ItemU("Dynamic connector"), 0#, 0#)

Значит взять из Document Stencil шейп Dynamic connector и бросить его на активную страницу в координаты 0, 0.
Координаты не важны, так как после приклеивания он сам проложит нужный маршрут.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 06 сен 2018, 14:07 
Tumanov писал(а):
Значит взять из Document Stencil шейп Dynamic connector и бросить его на активную страницу в координаты 0, 0.
Координаты не важны, так как после приклеивания он сам проложит нужный маршрут.
про координаты согласен абсолютно. но в гипотетическом случае не в каждом документе в Document Stencil есть мастер Dynamic connector. для такого случая коннектор можно добавить кодом
Код:
Dim con As Visio.Shape
Set con = Application.ActiveWindow.Page.Drop(Application.ConnectorToolDataObject, 0, 0)
добавляется коннектор с форматированием по умолчанию
Hamit писал(а):
Код:
Application.ActiveWindow.Page.Drop Application.Documents.item("D:\Разные отчеты IT\Схемы\в Visio\Test_auto_draw_VBA_v2.vsdm").Masters.ItemU("Dynamic connector"), 0#, 0#
такой вариант применим для случая, если у коннектора должно быть специфическое форматирование отличное от форматирования коннектора по-умолчанию. предварительно отформатированный коннектор будет вытягиваться из документа открытого в той же сессии.


Пожаловаться на это сообщение
Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 07 сен 2018, 10:59 
Не в сети
Новичок

Зарегистрирован: 19 мар 2018, 14:10
Сообщений: 45
Использую Visio c: 2010
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Столкнулся с забавным багом при использовании моей формы.
одно из полей данных фигуры заполняется так:
Код:
.Cells("Prop.ШПД_Клиент.Value").Formula = Chr(34) & ClientNameTextBox.Value & Chr(34)

однако если в поле ClientNameTextBox.Value ввести, к примеру ОАО "Пупкин", то возникает ошибка.
Самое правильное решение, на мой взгляд, это перевести String в массив букв (а может и строк), найти символ " и добавить еще две кавычки "".

Может есть более умное решение?


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 07 сен 2018, 11:04 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 2253
Очков репутации: 100626

Добавить очки репутацииУменьшить очки репутации
Обычно используется Replace(string, Chr(34), Chr(34)&Chr(34))


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 07 сен 2018, 11:05 
Использовать правильные русские кавычки <<типа >>. Такие как автоматом вставляются в word.
Пишу с телефона


Пожаловаться на это сообщение
Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 07 сен 2018, 11:21 
Не в сети
Новичок

Зарегистрирован: 19 мар 2018, 14:10
Сообщений: 45
Использую Visio c: 2010
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Tumanov писал(а):
Обычно используется Replace(string, Chr(34), Chr(34)&Chr(34))

Супер, спасибо!!
Гость писал(а):
Использовать правильные русские кавычки <<типа >>. Такие как автоматом вставляются в word.

Так то да, вот только:
1. данные я методом копипаст беру из других источников (схем visio), и делать каждый раз доп замену возможно, конечно, но не хотелось бы..))
2. Даже при печати "по-русски" в данном форуме "правильные русские кавычки" не заменяются автоматом..))


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Атоматизация рисования схема visio через VBA
СообщениеДобавлено: 07 сен 2018, 11:22 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 2253
Очков репутации: 100626

Добавить очки репутацииУменьшить очки репутации
Цитата:
Использовать правильные русские кавычки <<типа >>

Вот этого делать не советую! Решив одну проблему, получите множество других.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 100 ]  На страницу Пред.  1, 2, 3, 4, 5  След.

Часовой пояс: UTC + 3 часа [ Летнее время ]



Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 9


Вы можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Вы можете создать форум бесплатно PHPBB3 на Getbb.Ru, Также возможно сделать готовый форум PHPBB2 на Mybb2.ru
Русская поддержка phpBB