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ó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ó 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ó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ó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 = "Í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ón completada."
magaegem("ES")("EXPORT_COMPLETE") = "Exportación completada."
magaegem("ES")("FILE_NOT_SELECTED") = "No se seleccionó ningún archivo. Operación cancelada."
magaegem("ES")("DUPLICATE_VALUE") = "Se encontró un valor duplicado: {0} en la fila {1}. La operación ha sido abortada."
magaegem("ES")("ALARM_NODE_NOT_FOUND") = "No se encontró el nodo 'Alarms' en el archivo XML."
magaegem("ES")("MEMBER_NODE_NOT_FOUND") = "No se encontró 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ón a SIPA completada."
magaegem("ES")("SIPA_EXPORT_SAVED") = "Exportación a SIPA completada y guardada en {0}"
magaegem("ES")("SIPA_EXPORT_NOT_SAVED") = "Exportació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") = "È stato trovato un valore duplicato: {0} nella riga {1}. L'operazione è stata interrotta."
magaegem("IT")("ALARM_NODE_NOT_FOUND") = "Il nodo 'Alarms' non è stato trovato nel file XML."
magaegem("IT")("MEMBER_NODE_NOT_FOUND") = "Il nodo 'Member' con Name='Alarms' non è 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