825 lines
29 KiB
QBasic
825 lines
29 KiB
QBasic
Attribute VB_Name = "Funciones"
|
||
Sub ImportSiemensXML()
|
||
Dim loxoxc As Object
|
||
Dim NeNlelx As Object
|
||
Dim lladmldla As Object
|
||
Dim mylArmAyya As Object
|
||
Dim i As Integer, j As Integer
|
||
Dim ws As Worksheet
|
||
Dim ieafPiPP As String
|
||
Dim arpeeiFFple As Long, arilureaCunCao As Long
|
||
Dim tlnusEubtbE As Object
|
||
Dim mbElulnbmE As Object
|
||
Dim pathParts() As String
|
||
Dim IrrwIdow As Integer
|
||
Dim nIdxxexI As Integer
|
||
Dim NemraNNbrN As String
|
||
Dim TppetDTpeeryba As String
|
||
Dim ftcssfoef As Integer
|
||
Dim s As Integer
|
||
Dim maatomxnSnnomxe As Integer
|
||
Dim tcoeteoIsixc As Integer
|
||
Dim latVatusra As String
|
||
Dim orrnnotisrd As String
|
||
Dim seostnntcNsorts As Object
|
||
Dim icctcaoaeirr As Date
|
||
Dim ecarutetuue As Date
|
||
Dim eBfeaacfa
|
||
Dim ioltusieosat As Boolean
|
||
Dim woRRoso As Long
|
||
Dim oeeRewRedxR As Long
|
||
Dim path As String
|
||
arpeeiFFple = 5
|
||
arilureaCunCao = 2
|
||
eBfeaacfa = 2020
|
||
ioltusieosat = False
|
||
ieafPiPP = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML")
|
||
If ieafPiPP = "False" Or ieafPiPP = "Falso" Then
|
||
Exit Sub
|
||
End If
|
||
ecarutetuue = Date
|
||
If ecarutetuue > DateSerial(eBfeaacfa + 4, 12, 31) Then
|
||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||
Exit Sub
|
||
End If
|
||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||
Set file = fso.GetFile(ieafPiPP)
|
||
icctcaoaeirr = file.DateCreated
|
||
If icctcaoaeirr > DateSerial(eBfeaacfa + 4, 12, 31) Then
|
||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||
Exit Sub
|
||
End If
|
||
Set ws = ActiveSheet
|
||
ws.Rows.Hidden = False
|
||
woRRoso = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||
Set loxoxc = CreateObject("MSXML2.DOMDocument")
|
||
loxoxc.async = False
|
||
loxoxc.Load (ieafPiPP)
|
||
loxoxc.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
||
Set lladmldla = loxoxc.SelectSingleNode("//a:Member[@Name='Alarms']")
|
||
If lladmldla Is Nothing Then
|
||
MsgBox GetTranslatedMessage("ALARM_NODE_NOT_FOUND"), vbExclamation
|
||
Exit Sub
|
||
End If
|
||
Set mylArmAyya = lladmldla.SelectNodes("a:Sections/a:Section/a:Member")
|
||
Dim aeebTrTmrb As Object
|
||
Set aeebTrTmrb = CreateObject("Scripting.Dictionary")
|
||
CreateAlarmTable lladmldla, aeebTrTmrb, ws, arilureaCunCao
|
||
ftcssfoef = arilureaCunCao
|
||
Dim oooNcNceuca As Collection
|
||
Set oooNcNceuca = New Collection
|
||
Application.ScreenUpdating = False
|
||
Application.Calculation = xlCalculationManual
|
||
Application.EnableEvents = False
|
||
Set rsgsgrFgoFpF = New progressForm
|
||
rsgsgrFgoFpF.Show vbModeless
|
||
For i = 0 To mylArmAyya.Length - 1
|
||
NemraNNbrN = mylArmAyya.item(i).Attributes.getNamedItem("Name").Text
|
||
TppetDTpeeryba = mylArmAyya.item(i).Attributes.getNamedItem("Datatype").Text
|
||
If i Mod 10 = 0 Then
|
||
rsgsgrFgoFpF.UpdateProgress CInt(i), mylArmAyya.Length
|
||
DoEvents
|
||
End If
|
||
If NemraNNbrN = "Section" Then
|
||
Set tlnusEubtbE = mylArmAyya.item(i).SelectNodes("a:Subelement")
|
||
maatomxnSnnomxe = 0
|
||
For Each mbElulnbmE In tlnusEubtbE
|
||
pathParts = Split(mbElulnbmE.Attributes.getNamedItem("Path").Text, ",")
|
||
If UBound(pathParts) >= 1 Then
|
||
tcoeteoIsixc = CInt(pathParts(1))
|
||
If tcoeteoIsixc > maatomxnSnnomxe Then
|
||
maatomxnSnnomxe = tcoeteoIsixc
|
||
End If
|
||
End If
|
||
Next mbElulnbmE
|
||
If ioltusieosat Then
|
||
For s = 1 To maatomxnSnnomxe
|
||
ws.Cells(arpeeiFFple, ftcssfoef + s - 1).value = "Section." & s
|
||
oooNcNceuca.Add "Section." & s
|
||
Next s
|
||
End If
|
||
For Each mbElulnbmE In tlnusEubtbE
|
||
path = mbElulnbmE.Attributes.getNamedItem("Path").Text
|
||
pathParts = Split(path, ",")
|
||
If aeebTrTmrb.Exists(CStr(CInt(pathParts(0)))) Then
|
||
IrrwIdow = aeebTrTmrb(CStr(CInt(pathParts(0))))("searchRowIndex")
|
||
If IrrwIdow >= 0 Then
|
||
If IrrwIdow = 0 Then
|
||
woRRoso = woRRoso + 1
|
||
IrrwIdow = woRRoso
|
||
ws.Cells(IrrwIdow, arilureaCunCao).value = CInt(pathParts(0))
|
||
aeebTrTmrb(CStr(CInt(pathParts(0))))("searchRowIndex") = IrrwIdow
|
||
End If
|
||
tcoeteoIsixc = CInt(pathParts(1))
|
||
nIdxxexI = ftcssfoef + tcoeteoIsixc - 1
|
||
latVatusra = mbElulnbmE.SelectSingleNode("a:StartValue").Text
|
||
ws.Cells(IrrwIdow, nIdxxexI).value = ImportBool(latVatusra)
|
||
End If
|
||
End If
|
||
Next mbElulnbmE
|
||
ftcssfoef = ftcssfoef + maatomxnSnnomxe
|
||
Else
|
||
Set tlnusEubtbE = mylArmAyya.item(i).SelectNodes("a:Subelement")
|
||
For j = 0 To tlnusEubtbE.Length - 1
|
||
path = tlnusEubtbE.item(j).Attributes.getNamedItem("Path").Text
|
||
If aeebTrTmrb.Exists(path) Then
|
||
IrrwIdow = aeebTrTmrb(path)("searchRowIndex")
|
||
If IrrwIdow >= 0 Then
|
||
If IrrwIdow = 0 Then
|
||
woRRoso = woRRoso + 1
|
||
IrrwIdow = woRRoso
|
||
ws.Cells(IrrwIdow, arilureaCunCao).value = aeebTrTmrb(path)("AlarmNumStartValue")
|
||
aeebTrTmrb(path)("searchRowIndex") = IrrwIdow
|
||
End If
|
||
latVatusra = tlnusEubtbE.item(j).SelectSingleNode("a:StartValue").Text
|
||
If InStr(TppetDTpeeryba, "Bool") > 0 Then
|
||
ws.Cells(IrrwIdow, ftcssfoef).value = ImportBool(latVatusra)
|
||
ElseIf InStr(TppetDTpeeryba, "Byte") > 0 Then
|
||
ws.Cells(IrrwIdow, ftcssfoef).value = ImportByte(latVatusra)
|
||
Else
|
||
ws.Cells(IrrwIdow, ftcssfoef).value = latVatusra
|
||
End If
|
||
End If
|
||
End If
|
||
Next j
|
||
ftcssfoef = ftcssfoef + 1
|
||
End If
|
||
Next i
|
||
If ioltusieosat Then
|
||
ws.Cells(arpeeiFFple, ftcssfoef).value = "Descripci<63>n"
|
||
End If
|
||
Set tlnusEubtbE = lladmldla.SelectNodes("a:Subelement")
|
||
Dim nsasalAumr As Integer
|
||
nsasalAumr = tlnusEubtbE.Length
|
||
For j = 0 To tlnusEubtbE.Length - 1
|
||
path = tlnusEubtbE.item(j).Attributes.getNamedItem("Path").Text
|
||
If i Mod 10 = 0 Then
|
||
rsgsgrFgoFpF.UpdateProgress CInt(j), tlnusEubtbE.Length - 1
|
||
DoEvents
|
||
End If
|
||
If aeebTrTmrb.Exists(path) Then
|
||
IrrwIdow = aeebTrTmrb(path)("searchRowIndex")
|
||
If IrrwIdow >= 0 Then
|
||
Set seostnntcNsorts = tlnusEubtbE.item(j).SelectSingleNode("a:Comment/a:MultiLanguageText")
|
||
If Not seostnntcNsorts Is Nothing Then
|
||
orrnnotisrd = seostnntcNsorts.Text
|
||
Else
|
||
orrnnotisrd = ""
|
||
End If
|
||
ws.Cells(IrrwIdow, ftcssfoef).value = orrnnotisrd
|
||
End If
|
||
End If
|
||
Next j
|
||
Dim rng As Range
|
||
Set rng = ws.Range(ws.Cells(arpeeiFFple + 1, 1), ws.Cells(woRRoso, ws.UsedRange.Columns.Count))
|
||
rng.Sort Key1:=ws.Cells(arpeeiFFple + 1, arilureaCunCao), Order1:=xlAscending, Header:=xlNo
|
||
Dim row As Long
|
||
Dim NamloumrCmu As Long
|
||
Dim NlNNraum As String
|
||
Dim oRbRseooobe As New Collection
|
||
NamloumrCmu = arilureaCunCao
|
||
Dim key As Variant
|
||
For Each key In aeebTrTmrb.Keys
|
||
If aeebTrTmrb(key)("searchRowIndex") <> 0 Then
|
||
On Error Resume Next
|
||
oRbRseooobe.Add aeebTrTmrb(key)("searchRowIndex"), CStr(aeebTrTmrb(key)("searchRowIndex"))
|
||
On Error GoTo 0
|
||
End If
|
||
Next key
|
||
For row = arpeeiFFple + 1 To woRRoso
|
||
NlNNraum = CStr(ws.Cells(row, NamloumrCmu).value)
|
||
On Error Resume Next
|
||
If IsEmpty(oRbRseooobe(CStr(row))) Then
|
||
ws.Rows(row).Hidden = True
|
||
End If
|
||
On Error GoTo 0
|
||
Next row
|
||
Unload rsgsgrFgoFpF
|
||
Application.ScreenUpdating = True
|
||
Application.Calculation = xlCalculationAutomatic
|
||
Application.EnableEvents = True
|
||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||
End Sub
|
||
Sub CreateAlarmTable(lladmldla As Object, aeebTrTmrb As Object, ws As Worksheet, arilureaCunCao As Long)
|
||
Dim emlaNdareoea As Object
|
||
Dim tlnusEubtbE As Object
|
||
Dim mbElulnbmE As Object
|
||
Dim latVatusra As String
|
||
Dim path As String
|
||
Dim wdahnsndsoRhIh As Long
|
||
Set emlaNdareoea = lladmldla.SelectSingleNode("a:Sections/a:Section/a:Member[@Name='AlarmNum']")
|
||
If Not emlaNdareoea Is Nothing Then
|
||
Set tlnusEubtbE = emlaNdareoea.SelectNodes("a:Subelement")
|
||
For Each mbElulnbmE In tlnusEubtbE
|
||
latVatusra = mbElulnbmE.SelectSingleNode("a:StartValue").Text
|
||
path = mbElulnbmE.Attributes.getNamedItem("Path").Text
|
||
If latVatusra = "0" Then
|
||
wdahnsndsoRhIh = -1
|
||
Else
|
||
wdahnsndsoRhIh = FindRowIndex(ws, arilureaCunCao, latVatusra)
|
||
End If
|
||
aeebTrTmrb.Add path, CreateObject("Scripting.Dictionary")
|
||
aeebTrTmrb(path).Add "AlarmNumStartValue", latVatusra
|
||
aeebTrTmrb(path).Add "AlarmNumPath", path
|
||
aeebTrTmrb(path).Add "searchRowIndex", wdahnsndsoRhIh
|
||
Next mbElulnbmE
|
||
Else
|
||
MsgBox "No se encontr<74> el nodo AlarmNum."
|
||
End If
|
||
End Sub
|
||
Function FindRowIndex(ws As Worksheet, column As Long, value As String) As Long
|
||
Dim woRRoso As Long
|
||
Dim i As Long
|
||
woRRoso = ws.Cells(ws.Rows.Count, column).End(xlUp).row
|
||
For i = 1 To woRRoso
|
||
If CStr(ws.Cells(i, column).value) = value Then
|
||
FindRowIndex = i
|
||
Exit Function
|
||
End If
|
||
Next i
|
||
FindRowIndex = 0
|
||
End Function
|
||
Function FindColumnIndex(ws As Worksheet, columnName As String, headerRow As Long, startColumn As Long) As Long
|
||
Dim col As Integer
|
||
Dim ssltmsConl As Integer
|
||
ssltmsConl = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).column
|
||
For col = startColumn To ssltmsConl
|
||
If ws.Cells(headerRow, col).value = columnName Then
|
||
FindColumnIndex = col
|
||
Exit Function
|
||
End If
|
||
Next col
|
||
FindColumnIndex = 0
|
||
End Function
|
||
Function FindRowByAlarmNum(ws As Worksheet, NlNNraum As Integer, arpeeiFFple As Integer, arilureaCunCao As Integer) As Integer
|
||
Dim woRRoso As Integer
|
||
Dim i As Integer
|
||
woRRoso = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||
For i = arpeeiFFple + 1 To woRRoso
|
||
If ws.Cells(i, arilureaCunCao).value = NlNNraum Then
|
||
FindRowByAlarmNum = i
|
||
Exit Function
|
||
End If
|
||
Next i
|
||
FindRowByAlarmNum = 0
|
||
End Function
|
||
Function ImportBool(latVatusra As String) As String
|
||
ImportBool = IIf(UCase(latVatusra) = "TRUE", "X", "")
|
||
End Function
|
||
Function ImportByte(latVatusra As String) As String
|
||
If Left(latVatusra, 3) = "16#" Then
|
||
ImportByte = CInt("&H" & Mid(latVatusra, 4))
|
||
Else
|
||
ImportByte = latVatusra
|
||
End If
|
||
End Function
|
||
Sub ExportSiemensXML()
|
||
Dim loxoxc As Object
|
||
Dim NeNlelx As Object
|
||
Dim blNlmbllmbamombs As Object
|
||
Dim i As Long, j As Long
|
||
Dim ws As Worksheet
|
||
Dim ieafPiPP As String
|
||
Dim arpeeiFFple As Integer, arilureaCunCao As Integer
|
||
Dim IrrwIdow As Variant
|
||
Dim nIdxxexI As Integer
|
||
Dim NemraNNbrN As String
|
||
Dim TppetDTpeeryba As String
|
||
Dim eelllulVu As Variant
|
||
Dim VNssVNluraVala As Object
|
||
Dim icctcaoaeirr As Date
|
||
Dim ecarutetuue As Date
|
||
Dim fso As Object
|
||
Dim file As Object
|
||
Dim eBfeaacfa As Integer
|
||
Dim nsasalAumr As Integer
|
||
Dim dicstcicosio As Object
|
||
Dim ectsesocine As Object
|
||
Dim dNbeobebed As Object
|
||
Dim mNNldlmEsbdodo As Object
|
||
Dim oRbRseooobe As New Collection
|
||
Dim iuVnalsuiaVq As Object
|
||
Set iuVnalsuiaVq = CreateObject("Scripting.Dictionary")
|
||
Dim cndiiodnciiapc As Boolean
|
||
Dim ilcduidVulalei As Variant
|
||
Dim tpooltRltRRR As Long
|
||
arpeeiFFple = 5
|
||
arilureaCunCao = 2
|
||
eBfeaacfa = 2020
|
||
ieafPiPP = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML para exportar")
|
||
If ieafPiPP = "False" Or ieafPiPP = "Falso" Then
|
||
Exit Sub
|
||
End If
|
||
ecarutetuue = Date
|
||
If ecarutetuue > DateSerial(eBfeaacfa + 4, 12, 31) Then
|
||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||
Exit Sub
|
||
End If
|
||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||
Set file = fso.GetFile(ieafPiPP)
|
||
icctcaoaeirr = file.DateCreated
|
||
If icctcaoaeirr > DateSerial(eBfeaacfa + 4, 12, 31) Then
|
||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||
Exit Sub
|
||
End If
|
||
Set ws = ActiveSheet
|
||
woRRoso = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||
cndiiodnciiapc = False
|
||
For IrrwIdow = arpeeiFFple + 1 To woRRoso
|
||
If Not ws.Rows(IrrwIdow).Hidden Then
|
||
eelllulVu = ws.Cells(IrrwIdow, arilureaCunCao).value
|
||
If Not IsEmpty(eelllulVu) Then
|
||
If iuVnalsuiaVq.Exists(CStr(eelllulVu)) Then
|
||
cndiiodnciiapc = True
|
||
ilcduidVulalei = eelllulVu
|
||
tpooltRltRRR = IrrwIdow
|
||
Exit For
|
||
Else
|
||
iuVnalsuiaVq.Add CStr(eelllulVu), IrrwIdow
|
||
End If
|
||
End If
|
||
End If
|
||
Next IrrwIdow
|
||
If cndiiodnciiapc Then
|
||
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", ilcduidVulalei), "{1}", tpooltRltRRR), vbExclamation
|
||
Exit Sub
|
||
End If
|
||
nsasalAumr = 0
|
||
For IrrwIdow = arpeeiFFple + 1 To woRRoso
|
||
If Not ws.Rows(IrrwIdow).Hidden Then
|
||
nsasalAumr = nsasalAumr + 1
|
||
oRbRseooobe.Add IrrwIdow
|
||
End If
|
||
Next IrrwIdow
|
||
Set loxoxc = CreateObject("MSXML2.DOMDocument")
|
||
loxoxc.async = False
|
||
loxoxc.Load (ieafPiPP)
|
||
loxoxc.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
||
Set blNlmbllmbamombs = loxoxc.SelectSingleNode("//a:Member[@Name='Alarms']")
|
||
If blNlmbllmbamombs Is Nothing Then
|
||
MsgBox GetTranslatedMessage("MEMBER_NODE_NOT_FOUND"), vbExclamation
|
||
Exit Sub
|
||
End If
|
||
Dim tyTTeadyTtpd As String
|
||
tyTTeadyTtpd = blNlmbllmbamombs.Attributes.getNamedItem("Datatype").Text
|
||
Dim pnrrtra As String
|
||
pnrrtra = "Array\[0\.\.\d+\]"
|
||
Dim emprmpmctct As String
|
||
emprmpmctct = "Array[0.." & (nsasalAumr - 1) & "]"
|
||
Dim exrer As Object
|
||
Set exrer = CreateObject("VBScript.RegExp")
|
||
exrer.pattern = pnrrtra
|
||
exrer.Global = True
|
||
exrer.IgnoreCase = False
|
||
tyTTeadyTtpd = exrer.Replace(tyTTeadyTtpd, emprmpmctct)
|
||
blNlmbllmbamombs.Attributes.getNamedItem("Datatype").Text = tyTTeadyTtpd
|
||
Dim iEsgxSttmsxnSibunnx As Object
|
||
Set iEsgxSttmsxnSibunnx = blNlmbllmbamombs.SelectNodes(".//a:Subelement")
|
||
For i = iEsgxSttmsxnSibunnx.Length - 1 To 0 Step -1
|
||
iEsgxSttmsxnSibunnx.item(i).ParentNode.RemoveChild iEsgxSttmsxnSibunnx.item(i)
|
||
Next i
|
||
Dim ggxieNogSgddotdoNtns As Object
|
||
Set ggxieNogSgddotdoNtns = blNlmbllmbamombs.SelectSingleNode("a:Sections")
|
||
If Not ggxieNogSgddotdoNtns Is Nothing Then
|
||
blNlmbllmbamombs.RemoveChild ggxieNogSgddotdoNtns
|
||
End If
|
||
Set dicstcicosio = loxoxc.createNode(1, "Sections", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
blNlmbllmbamombs.appendChild dicstcicosio
|
||
Set ectsesocine = loxoxc.createNode(1, "Section", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
ectsesocine.Attributes.setNamedItem(loxoxc.createAttribute("Name")).Text = "None"
|
||
dicstcicosio.appendChild ectsesocine
|
||
Dim rrrsreb As Variant
|
||
rrrsreb = Array("AlarmNum", "DB", "Byte", "Bit", "Priority", "Section", "Value", "Disable", "Is Warning", "Ons")
|
||
Dim ebeCbmrCe As Variant
|
||
ebeCbmrCe = Array(0, 1, 2, 3, 4, 5, 10, 11, 12, 13)
|
||
Dim pdsapdeas As Variant
|
||
pdsapdeas = Array("Int", "Int", "Int", "Byte", "Byte", "Array[1..""Numero_Sezioni""] of Bool", "Bool", "Bool", "Bool", "Bool")
|
||
Set rsgsgrFgoFpF = New progressForm
|
||
rsgsgrFgoFpF.Show vbModeless
|
||
For i = 0 To UBound(rrrsreb)
|
||
Set dNbeobebed = loxoxc.createNode(1, "Member", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
dNbeobebed.Attributes.setNamedItem(loxoxc.createAttribute("Name")).Text = rrrsreb(i)
|
||
dNbeobebed.Attributes.setNamedItem(loxoxc.createAttribute("Datatype")).Text = pdsapdeas(i)
|
||
ectsesocine.appendChild dNbeobebed
|
||
rsgsgrFgoFpF.UpdateProgress CInt(i), UBound(rrrsreb)
|
||
If rrrsreb(i) = "Section" Then
|
||
Dim nibveixRxnwbRil As Integer
|
||
nibveixRxnwbRil = 0
|
||
For Each IrrwIdow In oRbRseooobe
|
||
For j = 1 To 5
|
||
Set mNNldlmEsbdodo = loxoxc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
mNNldlmEsbdodo.Attributes.setNamedItem(loxoxc.createAttribute("Path")).Text = nibveixRxnwbRil & "," & j
|
||
Set VNssVNluraVala = loxoxc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
eelllulVu = ws.Cells(IrrwIdow, arilureaCunCao + ebeCbmrCe(i) + j - 1).value
|
||
VNssVNluraVala.Text = ExportBool(Trim(eelllulVu))
|
||
mNNldlmEsbdodo.appendChild VNssVNluraVala
|
||
dNbeobebed.appendChild mNNldlmEsbdodo
|
||
Next j
|
||
nibveixRxnwbRil = nibveixRxnwbRil + 1
|
||
Next IrrwIdow
|
||
Else
|
||
nibveixRxnwbRil = 0
|
||
For Each IrrwIdow In oRbRseooobe
|
||
Set mNNldlmEsbdodo = loxoxc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
mNNldlmEsbdodo.Attributes.setNamedItem(loxoxc.createAttribute("Path")).Text = CStr(nibveixRxnwbRil)
|
||
Set VNssVNluraVala = loxoxc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
eelllulVu = ws.Cells(IrrwIdow, arilureaCunCao + ebeCbmrCe(i)).value
|
||
Select Case pdsapdeas(i)
|
||
Case "Bool"
|
||
VNssVNluraVala.Text = ExportBool(Trim(eelllulVu))
|
||
Case "Byte"
|
||
VNssVNluraVala.Text = ExportByte(eelllulVu)
|
||
Case "Int"
|
||
VNssVNluraVala.Text = IIf(IsNumeric(eelllulVu), CStr(CInt(eelllulVu)), "0")
|
||
Case Else
|
||
VNssVNluraVala.Text = CStr(eelllulVu)
|
||
End Select
|
||
mNNldlmEsbdodo.appendChild VNssVNluraVala
|
||
dNbeobebed.appendChild mNNldlmEsbdodo
|
||
nibveixRxnwbRil = nibveixRxnwbRil + 1
|
||
Next IrrwIdow
|
||
End If
|
||
Next i
|
||
Dim ouCulueoeueoC As Integer
|
||
ouCulueoeueoC = arilureaCunCao + 14
|
||
nibveixRxnwbRil = 0
|
||
For Each IrrwIdow In oRbRseooobe
|
||
Set mNNldlmEsbdodo = loxoxc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
mNNldlmEsbdodo.Attributes.setNamedItem(loxoxc.createAttribute("Path")).Text = CStr(nibveixRxnwbRil)
|
||
Dim cmtetNettot As Object
|
||
Set cmtetNettot = loxoxc.createNode(1, "Comment", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
Dim oTTgLliteadmumiag As Object
|
||
Set oTTgLliteadmumiag = loxoxc.createNode(1, "MultiLanguageText", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
oTTgLliteadmumiag.Attributes.setNamedItem(loxoxc.createAttribute("Lang")).Text = "it-IT"
|
||
oTTgLliteadmumiag.Text = ws.Cells(IrrwIdow, ouCulueoeueoC).value
|
||
cmtetNettot.appendChild oTTgLliteadmumiag
|
||
mNNldlmEsbdodo.appendChild cmtetNettot
|
||
blNlmbllmbamombs.appendChild mNNldlmEsbdodo
|
||
nibveixRxnwbRil = nibveixRxnwbRil + 1
|
||
Next IrrwIdow
|
||
loxoxc.Save ieafPiPP
|
||
Unload rsgsgrFgoFpF
|
||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||
End Sub
|
||
Function ExistsInCollection(col As Collection, key As Variant) As Boolean
|
||
On Error GoTo ErrHandler
|
||
Dim item As Variant
|
||
item = col(key)
|
||
ExistsInCollection = True
|
||
Exit Function
|
||
ErrHandler:
|
||
ExistsInCollection = False
|
||
End Function
|
||
Function IndexOf(arr As Variant, value As Variant) As Integer
|
||
Dim i As Integer
|
||
For i = LBound(arr) To UBound(arr)
|
||
If arr(i) = value Then
|
||
IndexOf = i - LBound(arr) + 1
|
||
Exit Function
|
||
End If
|
||
Next i
|
||
IndexOf = -1
|
||
End Function
|
||
Sub QuickSort(arr As Variant, first As Long, last As Long)
|
||
Dim low As Long, high As Long
|
||
Dim pvvov As Variant, temp As Variant
|
||
low = first
|
||
high = last
|
||
pvvov = arr((first + last) \ 2)
|
||
Do While low <= high
|
||
Do While arr(low) < pvvov
|
||
low = low + 1
|
||
Loop
|
||
Do While arr(high) > pvvov
|
||
high = high - 1
|
||
Loop
|
||
If low <= high Then
|
||
temp = arr(low)
|
||
arr(low) = arr(high)
|
||
arr(high) = temp
|
||
low = low + 1
|
||
high = high - 1
|
||
End If
|
||
Loop
|
||
If first < high Then QuickSort arr, first, high
|
||
If low < last Then QuickSort arr, low, last
|
||
End Sub
|
||
Function ExportBool(excelValue)
|
||
ExportBool = "FALSE"
|
||
If UCase(excelValue) = "X" Or UCase(excelValue) = "TRUE" Or UCase(excelValue) = "1" Then
|
||
ExportBool = "TRUE"
|
||
End If
|
||
End Function
|
||
Function ExportByte(eelllulVu)
|
||
If IsNumeric(eelllulVu) Then
|
||
decimalValue = CLng(eelllulVu)
|
||
hexValue = Hex(decimalValue)
|
||
If Len(hexValue) < 2 Then
|
||
hexValue = "0" & hexValue
|
||
End If
|
||
eelllulVu = "16#" & hexValue
|
||
Else
|
||
eelllulVu = "16#00"
|
||
End If
|
||
ExportByte = eelllulVu
|
||
End Function
|
||
Sub MarcarFilasOcultas()
|
||
Dim i As Long
|
||
Dim umoMaallnmmro As Long
|
||
Dim arilureaCunCao As Long
|
||
Dim arpeeiFFple As Long
|
||
arilureaCunCao = 2
|
||
arpeeiFFple = 5 + 1
|
||
umoMaallnmmro = 17
|
||
Set ws = ActiveSheet
|
||
allmmaltui = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||
For i = arpeeiFFple To allmmaltui
|
||
If ws.Rows(i).Hidden Then
|
||
ws.Cells(i, umoMaallnmmro).value = "X"
|
||
Else
|
||
ws.Cells(i, umoMaallnmmro).value = ""
|
||
End If
|
||
Next i
|
||
End Sub
|
||
Sub OcultarFilasSegunMarca()
|
||
Dim i As Long
|
||
Dim umoMaallnmmro As Long
|
||
Dim arilureaCunCao As Long
|
||
Dim arpeeiFFple As Long
|
||
Dim allmmaltui As Long
|
||
Dim ws As Worksheet
|
||
Dim rsgsgrFgoFpF As progressForm
|
||
arilureaCunCao = 2
|
||
arpeeiFFple = 5
|
||
umoMaallnmmro = 17
|
||
Application.ScreenUpdating = False
|
||
Application.Calculation = xlCalculationManual
|
||
Application.EnableEvents = False
|
||
Set ws = ActiveSheet
|
||
ws.Rows.Hidden = False
|
||
allmmaltui = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||
Set rsgsgrFgoFpF = New progressForm
|
||
rsgsgrFgoFpF.Show vbModeless
|
||
For i = arpeeiFFple To allmmaltui
|
||
If UCase(ws.Cells(i, umoMaallnmmro).value) = "X" Then
|
||
ws.Rows(i).Hidden = True
|
||
End If
|
||
If i Mod 10 = 0 Then
|
||
rsgsgrFgoFpF.UpdateProgress i - arpeeiFFple + 1, allmmaltui - arpeeiFFple + 1
|
||
DoEvents
|
||
End If
|
||
Next i
|
||
Unload rsgsgrFgoFpF
|
||
Application.ScreenUpdating = True
|
||
Application.Calculation = xlCalculationAutomatic
|
||
Application.EnableEvents = True
|
||
MsgBox Replace(GetTranslatedMessage("ROWS_HIDDEN"), "{0}", CStr(allmmaltui - arpeeiFFple + 1)), vbInformation
|
||
End Sub
|
||
Sub MostrarTodasLasFilas()
|
||
Set ws = ActiveSheet
|
||
ws.Rows.Hidden = False
|
||
End Sub
|
||
Sub Exportar_A_SIPA()
|
||
Dim ws As Worksheet
|
||
Dim PAAAws As Worksheet
|
||
Dim arpeeiFFple As Integer, arilureaCunCao As Integer
|
||
Dim IrrwIdow As Variant
|
||
Dim eelllulVu As Variant
|
||
Dim woRRoso As Long
|
||
Dim nsasalAumr As Integer
|
||
Dim oRbRseooobe As New Collection
|
||
Dim iuVnalsuiaVq As Object
|
||
Dim cndiiodnciiapc As Boolean
|
||
Dim ilcduidVulalei As Variant
|
||
Dim tpooltRltRRR As Long
|
||
Dim tstcts As Object
|
||
Dim IsPAwcDPAc As Object
|
||
Dim key As Variant
|
||
Dim saiioiw As Long
|
||
Dim db As Long, xbyte As Long, bit As Long
|
||
Dim sSpRiwoStlw As Long
|
||
saiioiw = 2
|
||
arpeeiFFple = 5
|
||
arilureaCunCao = 2
|
||
Set ws = ActiveSheet
|
||
On Error Resume Next
|
||
Set PAAAws = ThisWorkbook.Worksheets("Per Supervisore SIPA")
|
||
On Error GoTo 0
|
||
If PAAAws Is Nothing Then
|
||
MsgBox GetTranslatedMessage("SIPA_SHEET_NOT_FOUND"), vbExclamation
|
||
Exit Sub
|
||
End If
|
||
Set iuVnalsuiaVq = CreateObject("Scripting.Dictionary")
|
||
Set tstcts = CreateDict("AlarmNum", 0, "DB", 1, "Byte", 2, "Bit", 3, "Priority", 4, _
|
||
"Section.1", 5, "Section.2", 6, "Section.3", 7, "Section.4", 8, _
|
||
"Section.5", 9, "Disable", 11, "Is Warning", 12, "Descripci<63>n", 14, "Hidden", 15)
|
||
Set IsPAwcDPAc = CreateDict("Alarm-Warning", 0, "Number", 1, "Tag", 2, "Sections", 3, _
|
||
"Priority", 4, "Description", 5, "Used", 6)
|
||
woRRoso = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||
cndiiodnciiapc = False
|
||
For IrrwIdow = arpeeiFFple + 1 To woRRoso
|
||
If Not ws.Rows(IrrwIdow).Hidden Then
|
||
eelllulVu = ws.Cells(IrrwIdow, arilureaCunCao).value
|
||
If Not IsEmpty(eelllulVu) Then
|
||
If iuVnalsuiaVq.Exists(CStr(eelllulVu)) Then
|
||
cndiiodnciiapc = True
|
||
ilcduidVulalei = eelllulVu
|
||
tpooltRltRRR = IrrwIdow
|
||
Exit For
|
||
Else
|
||
iuVnalsuiaVq.Add CStr(eelllulVu), IrrwIdow
|
||
End If
|
||
End If
|
||
End If
|
||
Next IrrwIdow
|
||
If cndiiodnciiapc Then
|
||
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", ilcduidVulalei), "{1}", tpooltRltRRR), vbExclamation
|
||
Exit Sub
|
||
End If
|
||
nsasalAumr = 0
|
||
For IrrwIdow = arpeeiFFple + 1 To woRRoso
|
||
If Not ws.Rows(IrrwIdow).Hidden Then
|
||
nsasalAumr = nsasalAumr + 1
|
||
oRbRseooobe.Add IrrwIdow
|
||
End If
|
||
Next IrrwIdow
|
||
sSpRiwoStlw = PAAAws.Cells(PAAAws.Rows.Count, 1).End(xlUp).row
|
||
If sSpRiwoStlw >= saiioiw Then
|
||
PAAAws.Rows(saiioiw & ":" & sSpRiwoStlw).Delete
|
||
End If
|
||
For Each IrrwIdow In oRbRseooobe
|
||
For Each key In IsPAwcDPAc.Keys
|
||
Select Case key
|
||
Case "Alarm-Warning"
|
||
If UCase(ws.Cells(IrrwIdow, tstcts("Is Warning") + arilureaCunCao).value) = "X" Then
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = "Warning"
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).Font.Color = RGB(0, 32, 240)
|
||
Else
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = "Alarm"
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).Font.Color = RGB(255, 0, 0)
|
||
End If
|
||
Case "Number"
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = ws.Cells(IrrwIdow, tstcts("AlarmNum") + arilureaCunCao).value
|
||
Case "Tag"
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = "DB" & ws.Cells(IrrwIdow, tstcts("DB") + arilureaCunCao).value & _
|
||
".DBX" & ws.Cells(IrrwIdow, tstcts("Byte") + arilureaCunCao).value & _
|
||
"." & ws.Cells(IrrwIdow, tstcts("Bit") + arilureaCunCao).value
|
||
Case "Sections"
|
||
Dim eccLnonnccL As String
|
||
Dim scnonmotmm As Integer
|
||
eccLnonnccL = ""
|
||
For scnonmotmm = 1 To 5
|
||
If UCase(ws.Cells(IrrwIdow, tstcts("Section." & scnonmotmm) + arilureaCunCao).value) = "X" Then
|
||
If eccLnonnccL <> "" Then
|
||
eccLnonnccL = eccLnonnccL & ","
|
||
End If
|
||
eccLnonnccL = eccLnonnccL & scnonmotmm
|
||
End If
|
||
Next scnonmotmm
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = eccLnonnccL
|
||
Case "Priority"
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = ws.Cells(IrrwIdow, tstcts("Priority") + arilureaCunCao).value
|
||
Case "Description"
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = ws.Cells(IrrwIdow, tstcts("Descripci<63>n") + arilureaCunCao).value
|
||
Case "Used"
|
||
If UCase(ws.Cells(IrrwIdow, tstcts("Disable") + arilureaCunCao).value) <> "X" Then
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = ChrW(9679)
|
||
Else
|
||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = "-"
|
||
End If
|
||
End Select
|
||
Next key
|
||
saiioiw = saiioiw + 1
|
||
Next IrrwIdow
|
||
Dim PtaePPaiwal As String
|
||
PtaePPaiwal = Application.GetSaveAsFilename(InitialFileName:="Mappa Allarmi Completa Supervisore", _
|
||
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
|
||
Title:="Guardar hoja SIPA como")
|
||
If PtaePPaiwal <> "False" Then
|
||
Dim robWbkrnwbb As Workbook
|
||
Set robWbkrnwbb = Application.Workbooks.Add
|
||
PAAAws.Copy Before:=robWbkrnwbb.Sheets(1)
|
||
Application.DisplayAlerts = False
|
||
robWbkrnwbb.Sheets(2).Delete
|
||
Application.DisplayAlerts = True
|
||
robWbkrnwbb.SaveAs Filename:=PtaePPaiwal
|
||
robWbkrnwbb.Close SaveChanges:=True
|
||
MsgBox Replace(GetTranslatedMessage("SIPA_EXPORT_SAVED"), "{0}", PtaePPaiwal), vbInformation
|
||
Else
|
||
MsgBox GetTranslatedMessage("SIPA_EXPORT_NOT_SAVED"), vbInformation
|
||
End If
|
||
MsgBox GetTranslatedMessage("SIPA_EXPORT_COMPLETE"), vbInformation
|
||
End Sub
|
||
Function GetDictValue(dict As Object, key As Variant) As Variant
|
||
If VarType(key) = vbString Then
|
||
GetDictValue = dict(key)
|
||
ElseIf IsNumeric(key) Then
|
||
If dict.Exists(key) Then
|
||
GetDictValue = dict(dict(key))
|
||
Else
|
||
GetDictValue = "<22>ndice no v<>lido"
|
||
End If
|
||
Else
|
||
GetDictValue = "Tipo de clave no v<>lido"
|
||
End If
|
||
End Function
|
||
Function CreateDict(ParamArray items()) As Object
|
||
Dim dict As Object
|
||
Dim i As Long
|
||
Set dict = CreateObject("Scripting.Dictionary")
|
||
For i = 0 To UBound(items) Step 2
|
||
If i + 1 <= UBound(items) Then
|
||
dict(items(i)) = items(i + 1)
|
||
End If
|
||
Next i
|
||
Set CreateDict = dict
|
||
End Function
|
||
Function GetDB(texto As String) As Long
|
||
Dim aeaars As Variant
|
||
aeaars = Split(texto, "/")
|
||
If UBound(aeaars) >= 0 Then
|
||
GetDB = CLng(aeaars(0))
|
||
Else
|
||
GetDB = -1
|
||
End If
|
||
End Function
|
||
Function GetByte(texto As String) As Long
|
||
Dim aeaars As Variant
|
||
aeaars = Split(texto, "/")
|
||
If UBound(aeaars) >= 1 Then
|
||
GetByte = CLng(aeaars(1))
|
||
Else
|
||
GetByte = -1
|
||
End If
|
||
End Function
|
||
Function GetBit(texto As String) As Long
|
||
Dim aeaars As Variant
|
||
aeaars = Split(texto, "/")
|
||
If UBound(aeaars) >= 2 Then
|
||
Dim aaabrib As String
|
||
aaabrib = Split(aeaars(2), " ")(0)
|
||
GetBit = CLng(aaabrib)
|
||
Else
|
||
GetBit = -1
|
||
End If
|
||
End Function
|
||
Function GetExcelLanguage() As String
|
||
Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
|
||
Case 1034
|
||
GetExcelLanguage = "ES"
|
||
Case 1040
|
||
GetExcelLanguage = "IT"
|
||
Case Else
|
||
GetExcelLanguage = "EN"
|
||
End Select
|
||
End Function
|
||
Function GetTranslatedMessage(msgKey As String) As String
|
||
Dim magaegem As Object
|
||
Set magaegem = CreateObject("Scripting.Dictionary")
|
||
magaegem("EN") = CreateObject("Scripting.Dictionary")
|
||
magaegem("EN")("IMPORT_COMPLETE") = "Import completed."
|
||
magaegem("EN")("EXPORT_COMPLETE") = "Export completed."
|
||
magaegem("EN")("FILE_NOT_SELECTED") = "No file was selected. Operation cancelled."
|
||
magaegem("EN")("DUPLICATE_VALUE") = "A duplicate value was found: {0} in row {1}. The operation has been aborted."
|
||
magaegem("EN")("ALARM_NODE_NOT_FOUND") = "The 'Alarms' node was not found in the XML file."
|
||
magaegem("EN")("MEMBER_NODE_NOT_FOUND") = "The 'Member' node with Name='Alarms' was not found in the XML file."
|
||
magaegem("EN")("ROWS_HIDDEN") = "Process completed. Rows hidden: {0}"
|
||
magaegem("EN")("ALL_ROWS_SHOWN") = "All rows are now visible."
|
||
magaegem("EN")("SIPA_SHEET_NOT_FOUND") = "The 'Per Supervisore SIPA' sheet does not exist in this workbook. Please create this sheet before continuing."
|
||
magaegem("EN")("SIPA_EXPORT_COMPLETE") = "SIPA export completed."
|
||
magaegem("EN")("SIPA_EXPORT_SAVED") = "SIPA export completed and saved in {0}"
|
||
magaegem("EN")("SIPA_EXPORT_NOT_SAVED") = "SIPA export completed. Not saved in a separate file."
|
||
magaegem("ES") = CreateObject("Scripting.Dictionary")
|
||
magaegem("ES")("IMPORT_COMPLETE") = "Importaci<63>n completada."
|
||
magaegem("ES")("EXPORT_COMPLETE") = "Exportaci<63>n completada."
|
||
magaegem("ES")("FILE_NOT_SELECTED") = "No se seleccion<6F> ning<6E>n archivo. Operaci<63>n cancelada."
|
||
magaegem("ES")("DUPLICATE_VALUE") = "Se encontr<74> un valor duplicado: {0} en la fila {1}. La operaci<63>n ha sido abortada."
|
||
magaegem("ES")("ALARM_NODE_NOT_FOUND") = "No se encontr<74> el nodo 'Alarms' en el archivo XML."
|
||
magaegem("ES")("MEMBER_NODE_NOT_FOUND") = "No se encontr<74> el nodo 'Member' con Name='Alarms' en el archivo XML."
|
||
magaegem("ES")("ROWS_HIDDEN") = "Proceso completado. Filas ocultadas: {0}"
|
||
magaegem("ES")("ALL_ROWS_SHOWN") = "Todas las filas son ahora visibles."
|
||
magaegem("ES")("SIPA_SHEET_NOT_FOUND") = "La hoja 'Per Supervisore SIPA' no existe en este libro. Por favor, cree esta hoja antes de continuar."
|
||
magaegem("ES")("SIPA_EXPORT_COMPLETE") = "Exportaci<63>n a SIPA completada."
|
||
magaegem("ES")("SIPA_EXPORT_SAVED") = "Exportaci<63>n a SIPA completada y guardada en {0}"
|
||
magaegem("ES")("SIPA_EXPORT_NOT_SAVED") = "Exportaci<63>n a SIPA completada. No se ha guardado en un archivo separado."
|
||
magaegem("IT") = CreateObject("Scripting.Dictionary")
|
||
magaegem("IT")("IMPORT_COMPLETE") = "Importazione completata."
|
||
magaegem("IT")("EXPORT_COMPLETE") = "Esportazione completata."
|
||
magaegem("IT")("FILE_NOT_SELECTED") = "Nessun file selezionato. Operazione annullata."
|
||
magaegem("IT")("DUPLICATE_VALUE") = "<22> stato trovato un valore duplicato: {0} nella riga {1}. L'operazione <20> stata interrotta."
|
||
magaegem("IT")("ALARM_NODE_NOT_FOUND") = "Il nodo 'Alarms' non <20> stato trovato nel file XML."
|
||
magaegem("IT")("MEMBER_NODE_NOT_FOUND") = "Il nodo 'Member' con Name='Alarms' non <20> stato trovato nel file XML."
|
||
magaegem("IT")("ROWS_HIDDEN") = "Processo completato. Righe nascoste: {0}"
|
||
magaegem("IT")("ALL_ROWS_SHOWN") = "Tutte le righe sono ora visibili."
|
||
magaegem("IT")("SIPA_SHEET_NOT_FOUND") = "Il foglio 'Per Supervisore SIPA' non esiste in questa cartella di lavoro. Si prega di creare questo foglio prima di continuare."
|
||
magaegem("IT")("SIPA_EXPORT_COMPLETE") = "Esportazione SIPA completata."
|
||
magaegem("IT")("SIPA_EXPORT_SAVED") = "Esportazione SIPA completata e salvata in {0}"
|
||
magaegem("IT")("SIPA_EXPORT_NOT_SAVED") = "Esportazione SIPA completata. Non salvata in un file separato."
|
||
Dim lang As String
|
||
lang = GetExcelLanguage()
|
||
If magaegem(lang).Exists(msgKey) Then
|
||
GetTranslatedMessage = magaegem(lang)(msgKey)
|
||
Else
|
||
GetTranslatedMessage = magaegem("EN")(msgKey)
|
||
End If
|
||
End Function |