Получилось, по мне так, вполне сносно..))
Вот так это выглядит:
Встроенное видео спрятано под спойлер ↓ Прямая ссылка на видеоКод:
Код:
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
Если более опытные программеры подскажут, что можно усовершенствовать - буду рад
Ну и осталось еще нарисовать соединительные линии, я так и не понял пока как соединить определенные точки соединения определенной фигуры с другой точкой другой фигуры.
А также есть недоработка по scroll в ComboBox через ролик Мыши.
Если по данному поводу наведете на мысль - будет здорово