Так, все вірно! Звічайно що поділюся!
Необхідно пару рядкив дописати до орігинала, та при відкриття вже зєднаної ліні буде малювати з кольорами
Зміни зробив у IntToVal функції . Тут модіфіцірована функція:
Public Sub IntToVal(Row, Col As Long, val As Variant)
Dim s As String
Dim loss As Double
Dim c As Long
Dim p As Long
Dim fakul As Long
Dim PLC2s As String
'Dim log As New cLog: log.init "IntToVal"
Select Case Col
Case 1
s = IIf(val = 0, "Int", "Cas" & val)
Case 2, 6
Select Case val
Case -6: s = "PLC"
Case -5: s = "FBT"
Case -8: s = "PLC2"
Case -7: s = "FBT2"
Case Is > 0: s = "Ab" & val
Case 0: s = ""
Case Else: s = "Cab" & Abs(val)
End Select
Case 3, 7
s = lst.TextMatrix(Row, Col - 1)
If InStr(s, "Ab") > 0 Then
s = "FTTH"
' lst.Cell(flexcpBackColor, Row, Col) = GetRGB_Hex("RGB(200,200,200)")
End If
If InStr(s, "FBT") > 0 Then 'Atszinezem az FTB hateret
s = "Split"
lst.Cell(flexcpBackColor, Row, Col) = GetRGB_Hex("RGB(100,10,160)")
lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(100,10,160)")
lst.Cell(flexcpForeColor, Row, Col) = GetRGB_Hex("RGB(255,255,0)")
lst.Cell(flexcpForeColor, Row, Col - 1) = GetRGB_Hex("RGB(255,255,0)")
End If
If InStr(s, "PLC") > 0 Then s = "Split"
If InStr(s, "FBT") > 0 Then s = "Split"
If box.isFTTH(ToVal(Row, Col - 1)) Then s = "FTTH"
If s = lst.TextMatrix(Row, Col - 1) Then
If Trim(lst.TextMatrix(Row, Col)) = "" Then s = val Else s = lst.TextMatrix(Row, Col)
End If
If VBA.val(s) > 0 Then
'-=-=-=-=-=-=-
p = VBA.val("-" & Replace(lst.Cell(flexcpText, Row, Col - 2), "Cab", ""))
c = GetFiber_Color(VBA.val(s), box.GetFibesOnPort(p), box.GetColorsOnPort(p))
lst.Cell(flexcpBackColor, Row, Col) = c
lst.Cell(flexcpForeColor, Row, Col) = IIf((GetRGB_Hex(cBlack) = c) Or _
(GetRGB_Hex(cBlue) = c) Or _
(GetRGB_Hex(cBrown) = c) Or _
(GetRGB_Hex(cGray) = c) Or _
(GetRGB_Hex(cViolet) = c), _
RGB(255, 255, 255), 1)
Else
' lst.Cell(flexcpBackColor, Row, Col) = GetRGB_Hex("RGB(200,200,200)")
End If
Case 4, 8
s = lst.TextMatrix(Row, Col - 2)
If InStr(s, "Ab") > 0 Then
s = "One"
' lst.Cell(flexcpBackColor, Row, Col) = GetRGB_Hex("RGB(200,200,200)")
Else
'//szinezes
'----=== //Kabelek szinezese
If InStr(s, "Cab1") > 0 Then 'Atszinezem ha ez Cab1
lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(200,240,255)")
lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(200,240,255)")
End If
If InStr(s, "Cab2") > 0 Then 'Atszinezem ha ez Cab2
lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(255,150,240)")
lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(255,150,240)")
End If
If InStr(s, "Cab3") > 0 Then 'Atszinezem ha ez Cab3
lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(255,250,170)")
lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(255,250,170)")
End If
If InStr(s, "Cab4") > 0 Then 'Atszinezem ha ez Cab4
lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(100,255,80)")
lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(100,255,80)")
End If
'----=== Kabelek szinezese\\
If InStr(s, "PLC") > 0 Then 'Atszinezem ha ez PLC-s felirat
If InStr(s, "2") > 0 Then 'megkulonkoztetjuk a PLC es a PLC2-ot
PLC2s = "Sec"
fakul = 10
lst.Cell(flexcpBackColor, Row, Col - 0) = GetRGB_Hex("RGB(220,220,220)") 'Volokno oszlop
lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(220,220,220)") 'Moduly
lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(220,220,220)") 'Port
lst.Cell(flexcpForeColor, Row, Col - 0) = GetRGB_Hex("RGB(200,22,222)")
lst.Cell(flexcpForeColor, Row, Col - 1) = GetRGB_Hex("RGB(200,22,222)")
lst.Cell(flexcpForeColor, Row, Col - 2) = GetRGB_Hex("RGB(200,22,222)")
Else
PLC2s = ""
fakul = 0
lst.Cell(flexcpBackColor, Row, Col - 0) = GetRGB_Hex("RGB(245,245,245)")
lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(245,245,245)")
lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(245,245,245)")
lst.Cell(flexcpForeColor, Row, Col - 0) = GetRGB_Hex("RGB(0,0,255)")
lst.Cell(flexcpForeColor, Row, Col - 1) = GetRGB_Hex("RGB(0,0,255)")
lst.Cell(flexcpForeColor, Row, Col - 2) = GetRGB_Hex("RGB(0,0,255)")
End If
s = Trim(val)
If val = 1 Then s = PLC2s & "PLC_In" 'Az elso sor az Input lesz
If val > 1 Then 'ha nem az elso, akkor ez kimenet
p = VBA.val("-" & Replace(lst.Cell(flexcpText, Row, Col - 2), "Cab", ""))
c = GetFiber_Color(VBA.val(s - 1), box.GetFibesOnPort(p), box.GetColorsOnPort(p))
lst.Cell(flexcpBackColor, Row, Col) = c
'a sotet kockaba feherrel irjuk a szamot
lst.Cell(flexcpForeColor, Row, Col) = IIf((GetRGB_Hex(cBlack) = c) Or (GetRGB_Hex(cBlue) = c) Or _
(GetRGB_Hex(cBrown) = c) Or (GetRGB_Hex(cGray) = c) Or _
(GetRGB_Hex(cViolet) = c), RGB(255, 255, 255), 1)
s = PLC2s & "PLC-" & Trim(val - 1)
End If '{If val > 1}
Else '{If InStr(s, "PLC") > 0}
'szinezes\\
s = Trim(val)
If val > 0 Then
'-=-=-=-=-=-=-
p = VBA.val("-" & Replace(lst.Cell(flexcpText, Row, Col - 2), "Cab", ""))
c = GetFiber_Color(VBA.val(s), box.GetFibesOnPort(p), box.GetColorsOnPort(p))
lst.Cell(flexcpBackColor, Row, Col) = c
lst.Cell(flexcpForeColor, Row, Col) = IIf((GetRGB_Hex(cBlack) = c) Or (GetRGB_Hex(cBlue) = c) Or _
(GetRGB_Hex(cBrown) = c) Or (GetRGB_Hex(cGray) = c) Or _
(GetRGB_Hex(cViolet) = c), RGB(255, 255, 255), 1)
End If '{If val > 0}
End If '{If InStr(s, "PLC")}
End If '{Else InStr(s, "Ab") > 0}
Case 5
Select Case val
Case -1
s = "Сварка"
loss = ActivePage.PageSheet.Cells("Prop.SpliceLoss")
Case -2
s = "Коннектор"
loss = ActivePage.PageSheet.Cells("Prop.ConLoss")
Case -3
s = "Пигтейл"
loss = ActivePage.PageSheet.Cells("Prop.ConLoss") + ActivePage.PageSheet.Cells("Prop.SpliceLoss")
Case Else
s = "Сварка"
loss = val
End Select
lst.TextMatrix(Row, 9) = loss
End Select
lst.TextMatrix(Row, Col) = s
End Sub
Признаю що не самий правільний код, але хотів щоб елементарно можна було візуально відризняти що волокно звідки приходить і з чим зєднуется. З кривими руками у мене получилося так Я не програміст!!!
