842 lines
30 KiB
QBasic
842 lines
30 KiB
QBasic
|
' dev Miguel Vera 2024 v0.5
|
|||
|
Sub ImportSiemensXML()
|
|||
|
Dim mxlxlm As Object
|
|||
|
Dim edNNmmd As Object
|
|||
|
Dim lellNadNl As Object
|
|||
|
Dim lmmmmAAArA As Object
|
|||
|
Dim i As Integer, j As Integer
|
|||
|
Dim ws As Worksheet
|
|||
|
Dim htPPilla As String
|
|||
|
Dim pFmmeFpprre As Long, irniaelmpoiaoi As Long
|
|||
|
Dim uebuenlnlms As Object
|
|||
|
Dim nbbsnstmtl As Object
|
|||
|
Dim pathParts() As String
|
|||
|
Dim wdxwdrdn As Integer
|
|||
|
Dim dedcexec As Integer
|
|||
|
Dim abbbaeeaaN As String
|
|||
|
Dim pprmmbtDDDDyar As String
|
|||
|
Dim sOscOOlco As Integer
|
|||
|
Dim s As Integer
|
|||
|
Dim amocidSeSaimaIm As Integer
|
|||
|
Dim xicItodoitto As Integer
|
|||
|
Dim tueltVutsr As String
|
|||
|
Dim idoostpiots As String
|
|||
|
Dim isttioepdeNtssn As Object
|
|||
|
Dim DaDtoionrret As Date
|
|||
|
Dim euDunccDene As Date
|
|||
|
Dim ehhfBsffe
|
|||
|
Dim rstereeooils As Boolean
|
|||
|
Dim aRllsRo As Long
|
|||
|
Dim dodenddwxow As Long
|
|||
|
Dim path As String
|
|||
|
pFmmeFpprre = 5
|
|||
|
irniaelmpoiaoi = 2
|
|||
|
ehhfBsffe = 2020
|
|||
|
rstereeooils = False
|
|||
|
htPPilla = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML")
|
|||
|
If htPPilla = "False" Or htPPilla = "Falso" Then
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
euDunccDene = Date
|
|||
|
If euDunccDene > DateSerial(ehhfBsffe + 4, 12, 31) Then
|
|||
|
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
Set fso = CreateObject("Scripting.FileSystemObject")
|
|||
|
Set file = fso.GetFile(htPPilla)
|
|||
|
DaDtoionrret = file.DateCreated
|
|||
|
If DaDtoionrret > DateSerial(ehhfBsffe + 4, 12, 31) Then
|
|||
|
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
Set ws = ActiveSheet
|
|||
|
ws.Rows.Hidden = False
|
|||
|
aRllsRo = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
|||
|
Set mxlxlm = CreateObject("MSXML2.DOMDocument")
|
|||
|
mxlxlm.async = False
|
|||
|
mxlxlm.Load (htPPilla)
|
|||
|
mxlxlm.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
|||
|
Set lellNadNl = mxlxlm.SelectSingleNode("//a:Member[@Name='Alarms']")
|
|||
|
If lellNadNl Is Nothing Then
|
|||
|
MsgBox GetTranslatedMessage("ALARM_NODE_NOT_FOUND"), vbExclamation
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
Set lmmmmAAArA = lellNadNl.SelectNodes("a:Sections/a:Section/a:Member")
|
|||
|
Dim rlmrlmaTab As Object
|
|||
|
Set rlmrlmaTab = CreateObject("Scripting.Dictionary")
|
|||
|
CreateAlarmTable lellNadNl, rlmrlmaTab, ws, irniaelmpoiaoi
|
|||
|
sOscOOlco = irniaelmpoiaoi
|
|||
|
Dim uNoslcneNcl As Collection
|
|||
|
Set uNoslcneNcl = New Collection
|
|||
|
Application.ScreenUpdating = False
|
|||
|
Application.Calculation = xlCalculationManual
|
|||
|
Application.EnableEvents = False
|
|||
|
Set FFosommpFmmo = New progressForm
|
|||
|
FFosommpFmmo.Show vbModeless
|
|||
|
For i = 0 To lmmmmAAArA.Length - 1
|
|||
|
abbbaeeaaN = lmmmmAAArA.item(i).Attributes.getNamedItem("Name").Text
|
|||
|
pprmmbtDDDDyar = lmmmmAAArA.item(i).Attributes.getNamedItem("Datatype").Text
|
|||
|
If i Mod 10 = 0 Then
|
|||
|
FFosommpFmmo.UpdateProgress CInt(i), lmmmmAAArA.Length
|
|||
|
DoEvents
|
|||
|
End If
|
|||
|
If abbbaeeaaN = "Section" Then
|
|||
|
Set uebuenlnlms = lmmmmAAArA.item(i).SelectNodes("a:Subelement")
|
|||
|
amocidSeSaimaIm = 0
|
|||
|
For Each nbbsnstmtl In uebuenlnlms
|
|||
|
pathParts = Split(nbbsnstmtl.Attributes.getNamedItem("Path").Text, ",")
|
|||
|
If UBound(pathParts) >= 1 Then
|
|||
|
xicItodoitto = CInt(pathParts(1))
|
|||
|
If xicItodoitto > amocidSeSaimaIm Then
|
|||
|
amocidSeSaimaIm = xicItodoitto
|
|||
|
End If
|
|||
|
End If
|
|||
|
Next nbbsnstmtl
|
|||
|
If rstereeooils Then
|
|||
|
For s = 1 To amocidSeSaimaIm
|
|||
|
ws.Cells(pFmmeFpprre, sOscOOlco + s - 1).value = "Section." & s
|
|||
|
uNoslcneNcl.Add "Section." & s
|
|||
|
Next s
|
|||
|
End If
|
|||
|
For Each nbbsnstmtl In uebuenlnlms
|
|||
|
path = nbbsnstmtl.Attributes.getNamedItem("Path").Text
|
|||
|
pathParts = Split(path, ",")
|
|||
|
If rlmrlmaTab.Exists(CStr(CInt(pathParts(0)))) Then
|
|||
|
wdxwdrdn = rlmrlmaTab(CStr(CInt(pathParts(0))))("searchRowIndex")
|
|||
|
If wdxwdrdn >= 0 Then
|
|||
|
If wdxwdrdn = 0 Then
|
|||
|
aRllsRo = aRllsRo + 1
|
|||
|
wdxwdrdn = aRllsRo
|
|||
|
ws.Cells(wdxwdrdn, irniaelmpoiaoi).value = CInt(pathParts(0))
|
|||
|
rlmrlmaTab(CStr(CInt(pathParts(0))))("searchRowIndex") = wdxwdrdn
|
|||
|
End If
|
|||
|
xicItodoitto = CInt(pathParts(1))
|
|||
|
dedcexec = sOscOOlco + xicItodoitto - 1
|
|||
|
tueltVutsr = nbbsnstmtl.SelectSingleNode("a:StartValue").Text
|
|||
|
ws.Cells(wdxwdrdn, dedcexec).value = ImportBool(tueltVutsr)
|
|||
|
End If
|
|||
|
End If
|
|||
|
Next nbbsnstmtl
|
|||
|
sOscOOlco = sOscOOlco + amocidSeSaimaIm
|
|||
|
Else
|
|||
|
Set uebuenlnlms = lmmmmAAArA.item(i).SelectNodes("a:Subelement")
|
|||
|
For j = 0 To uebuenlnlms.Length - 1
|
|||
|
path = uebuenlnlms.item(j).Attributes.getNamedItem("Path").Text
|
|||
|
If rlmrlmaTab.Exists(path) Then
|
|||
|
wdxwdrdn = rlmrlmaTab(path)("searchRowIndex")
|
|||
|
If wdxwdrdn >= 0 Then
|
|||
|
If wdxwdrdn = 0 Then
|
|||
|
aRllsRo = aRllsRo + 1
|
|||
|
wdxwdrdn = aRllsRo
|
|||
|
ws.Cells(wdxwdrdn, irniaelmpoiaoi).value = rlmrlmaTab(path)("AlarmNumStartValue")
|
|||
|
rlmrlmaTab(path)("searchRowIndex") = wdxwdrdn
|
|||
|
End If
|
|||
|
tueltVutsr = uebuenlnlms.item(j).SelectSingleNode("a:StartValue").Text
|
|||
|
If InStr(pprmmbtDDDDyar, "Bool") > 0 Then
|
|||
|
ws.Cells(wdxwdrdn, sOscOOlco).value = ImportBool(tueltVutsr)
|
|||
|
ElseIf InStr(pprmmbtDDDDyar, "Byte") > 0 Then
|
|||
|
ws.Cells(wdxwdrdn, sOscOOlco).value = ImportByte(tueltVutsr)
|
|||
|
Else
|
|||
|
ws.Cells(wdxwdrdn, sOscOOlco).value = tueltVutsr
|
|||
|
End If
|
|||
|
End If
|
|||
|
End If
|
|||
|
Next j
|
|||
|
sOscOOlco = sOscOOlco + 1
|
|||
|
End If
|
|||
|
Next i
|
|||
|
If rstereeooils Then
|
|||
|
ws.Cells(pFmmeFpprre, sOscOOlco).value = "Descripci<63>n"
|
|||
|
End If
|
|||
|
Set uebuenlnlms = lellNadNl.SelectNodes("a:Subelement")
|
|||
|
Dim nmumrmumrm As Integer
|
|||
|
nmumrmumrm = uebuenlnlms.Length
|
|||
|
For j = 0 To uebuenlnlms.Length - 1
|
|||
|
path = uebuenlnlms.item(j).Attributes.getNamedItem("Path").Text
|
|||
|
If i Mod 10 = 0 Then
|
|||
|
FFosommpFmmo.UpdateProgress CInt(j), uebuenlnlms.Length - 1
|
|||
|
DoEvents
|
|||
|
End If
|
|||
|
If rlmrlmaTab.Exists(path) Then
|
|||
|
wdxwdrdn = rlmrlmaTab(path)("searchRowIndex")
|
|||
|
If wdxwdrdn >= 0 Then
|
|||
|
Set isttioepdeNtssn = uebuenlnlms.item(j).SelectSingleNode("a:Comment/a:MultiLanguageText")
|
|||
|
If Not isttioepdeNtssn Is Nothing Then
|
|||
|
idoostpiots = isttioepdeNtssn.Text
|
|||
|
Else
|
|||
|
idoostpiots = ""
|
|||
|
End If
|
|||
|
ws.Cells(wdxwdrdn, sOscOOlco).value = idoostpiots
|
|||
|
End If
|
|||
|
End If
|
|||
|
Next j
|
|||
|
Dim rng As Range
|
|||
|
Set rng = ws.Range(ws.Cells(pFmmeFpprre + 1, 1), ws.Cells(aRllsRo, ws.UsedRange.Columns.Count))
|
|||
|
rng.Sort Key1:=ws.Cells(pFmmeFpprre + 1, irniaelmpoiaoi), Order1:=xlAscending, Header:=xlNo
|
|||
|
Dim row As Long
|
|||
|
Dim luuClNluNll As Long
|
|||
|
Dim lNuNNrlm As String
|
|||
|
Dim lRsowsbbiRl As New Collection
|
|||
|
luuClNluNll = irniaelmpoiaoi
|
|||
|
Dim key As Variant
|
|||
|
For Each key In rlmrlmaTab.Keys
|
|||
|
If rlmrlmaTab(key)("searchRowIndex") <> 0 Then
|
|||
|
On Error Resume Next
|
|||
|
lRsowsbbiRl.Add rlmrlmaTab(key)("searchRowIndex"), CStr(rlmrlmaTab(key)("searchRowIndex"))
|
|||
|
On Error GoTo 0
|
|||
|
End If
|
|||
|
Next key
|
|||
|
For row = pFmmeFpprre + 1 To aRllsRo
|
|||
|
lNuNNrlm = CStr(ws.Cells(row, luuClNluNll).value)
|
|||
|
On Error Resume Next
|
|||
|
If IsEmpty(lRsowsbbiRl(CStr(row))) Then
|
|||
|
ws.Rows(row).Hidden = True
|
|||
|
End If
|
|||
|
On Error GoTo 0
|
|||
|
Next row
|
|||
|
Unload FFosommpFmmo
|
|||
|
Application.ScreenUpdating = True
|
|||
|
Application.Calculation = xlCalculationAutomatic
|
|||
|
Application.EnableEvents = True
|
|||
|
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
|||
|
End Sub
|
|||
|
Sub CreateAlarmTable(lellNadNl As Object, rlmrlmaTab As Object, ws As Worksheet, irniaelmpoiaoi As Long)
|
|||
|
Dim olmdomulaaNd As Object
|
|||
|
Dim uebuenlnlms As Object
|
|||
|
Dim nbbsnstmtl As Object
|
|||
|
Dim tueltVutsr As String
|
|||
|
Dim path As String
|
|||
|
Dim IIexRdaswxxoha As Long
|
|||
|
Set olmdomulaaNd = lellNadNl.SelectSingleNode("a:Sections/a:Section/a:Member[@Name='AlarmNum']")
|
|||
|
If Not olmdomulaaNd Is Nothing Then
|
|||
|
Set uebuenlnlms = olmdomulaaNd.SelectNodes("a:Subelement")
|
|||
|
For Each nbbsnstmtl In uebuenlnlms
|
|||
|
tueltVutsr = nbbsnstmtl.SelectSingleNode("a:StartValue").Text
|
|||
|
path = nbbsnstmtl.Attributes.getNamedItem("Path").Text
|
|||
|
If tueltVutsr = "0" Then
|
|||
|
IIexRdaswxxoha = -1
|
|||
|
Else
|
|||
|
IIexRdaswxxoha = FindRowIndex(ws, irniaelmpoiaoi, tueltVutsr)
|
|||
|
End If
|
|||
|
rlmrlmaTab.Add path, CreateObject("Scripting.Dictionary")
|
|||
|
rlmrlmaTab(path).Add "AlarmNumStartValue", tueltVutsr
|
|||
|
rlmrlmaTab(path).Add "AlarmNumPath", path
|
|||
|
rlmrlmaTab(path).Add "searchRowIndex", IIexRdaswxxoha
|
|||
|
Next nbbsnstmtl
|
|||
|
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 aRllsRo As Long
|
|||
|
Dim i As Long
|
|||
|
aRllsRo = ws.Cells(ws.Rows.Count, column).End(xlUp).row
|
|||
|
For i = 1 To aRllsRo
|
|||
|
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 CCulnCasmC As Integer
|
|||
|
CCulnCasmC = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).column
|
|||
|
For col = startColumn To CCulnCasmC
|
|||
|
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, lNuNNrlm As Integer, pFmmeFpprre As Integer, irniaelmpoiaoi As Integer) As Integer
|
|||
|
Dim aRllsRo As Integer
|
|||
|
Dim i As Integer
|
|||
|
aRllsRo = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
|||
|
For i = pFmmeFpprre + 1 To aRllsRo
|
|||
|
If ws.Cells(i, irniaelmpoiaoi).value = lNuNNrlm Then
|
|||
|
FindRowByAlarmNum = i
|
|||
|
Exit Function
|
|||
|
End If
|
|||
|
Next i
|
|||
|
FindRowByAlarmNum = 0
|
|||
|
End Function
|
|||
|
Function ImportBool(tueltVutsr As String) As String
|
|||
|
ImportBool = IIf(UCase(tueltVutsr) = "TRUE", "X", "")
|
|||
|
End Function
|
|||
|
Function ImportByte(tueltVutsr As String) As String
|
|||
|
If Left(tueltVutsr, 3) = "16#" Then
|
|||
|
ImportByte = CInt("&H" & Mid(tueltVutsr, 4))
|
|||
|
Else
|
|||
|
ImportByte = tueltVutsr
|
|||
|
End If
|
|||
|
End Function
|
|||
|
Sub ExportSiemensXML()
|
|||
|
Dim mxlxlm As Object
|
|||
|
Dim edNNmmd As Object
|
|||
|
Dim eaoadsNooomrbbsM As Object
|
|||
|
Dim i As Long, j As Long
|
|||
|
Dim ws As Worksheet
|
|||
|
Dim htPPilla As String
|
|||
|
Dim pFmmeFpprre As Integer, irniaelmpoiaoi As Integer
|
|||
|
Dim wdxwdrdn As Variant
|
|||
|
Dim dedcexec As Integer
|
|||
|
Dim abbbaeeaaN As String
|
|||
|
Dim pprmmbtDDDDyar As String
|
|||
|
Dim auecalual As Variant
|
|||
|
Dim telVuosuValsad As Object
|
|||
|
Dim DaDtoionrret As Date
|
|||
|
Dim euDunccDene As Date
|
|||
|
Dim fso As Object
|
|||
|
Dim file As Object
|
|||
|
Dim ehhfBsffe As Integer
|
|||
|
Dim nmumrmumrm As Integer
|
|||
|
Dim eoNNnttoNndt As Object
|
|||
|
Dim ecceNesNons As Object
|
|||
|
Dim Nmobbrbome As Object
|
|||
|
Dim bbdlnueueoemnm As Object
|
|||
|
Dim lRsowsbbiRl As New Collection
|
|||
|
Dim qslunnleeeuu As Object
|
|||
|
Set qslunnleeeuu = CreateObject("Scripting.Dictionary")
|
|||
|
Dim ueantFnaaplaet As Boolean
|
|||
|
Dim lcVpaVpcacpVue As Variant
|
|||
|
Dim RliiapcaoRdt As Long
|
|||
|
pFmmeFpprre = 5
|
|||
|
irniaelmpoiaoi = 2
|
|||
|
ehhfBsffe = 2020
|
|||
|
htPPilla = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML para exportar")
|
|||
|
If htPPilla = "False" Or htPPilla = "Falso" Then
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
euDunccDene = Date
|
|||
|
If euDunccDene > DateSerial(ehhfBsffe + 4, 12, 31) Then
|
|||
|
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
Set fso = CreateObject("Scripting.FileSystemObject")
|
|||
|
Set file = fso.GetFile(htPPilla)
|
|||
|
DaDtoionrret = file.DateCreated
|
|||
|
If DaDtoionrret > DateSerial(ehhfBsffe + 4, 12, 31) Then
|
|||
|
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
Set ws = ActiveSheet
|
|||
|
aRllsRo = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
|||
|
ueantFnaaplaet = False
|
|||
|
For wdxwdrdn = pFmmeFpprre + 1 To aRllsRo
|
|||
|
If Not ws.Rows(wdxwdrdn).Hidden Then
|
|||
|
auecalual = ws.Cells(wdxwdrdn, irniaelmpoiaoi).value
|
|||
|
If Not IsEmpty(auecalual) Then
|
|||
|
If qslunnleeeuu.Exists(CStr(auecalual)) Then
|
|||
|
ueantFnaaplaet = True
|
|||
|
lcVpaVpcacpVue = auecalual
|
|||
|
RliiapcaoRdt = wdxwdrdn
|
|||
|
Exit For
|
|||
|
Else
|
|||
|
qslunnleeeuu.Add CStr(auecalual), wdxwdrdn
|
|||
|
End If
|
|||
|
End If
|
|||
|
End If
|
|||
|
Next wdxwdrdn
|
|||
|
If ueantFnaaplaet Then
|
|||
|
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", lcVpaVpcacpVue), "{1}", RliiapcaoRdt), vbExclamation
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
nmumrmumrm = 0
|
|||
|
For wdxwdrdn = pFmmeFpprre + 1 To aRllsRo
|
|||
|
If Not ws.Rows(wdxwdrdn).Hidden Then
|
|||
|
nmumrmumrm = nmumrmumrm + 1
|
|||
|
lRsowsbbiRl.Add wdxwdrdn
|
|||
|
End If
|
|||
|
Next wdxwdrdn
|
|||
|
Set mxlxlm = CreateObject("MSXML2.DOMDocument")
|
|||
|
mxlxlm.async = False
|
|||
|
mxlxlm.Load (htPPilla)
|
|||
|
mxlxlm.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
|||
|
Set eaoadsNooomrbbsM = mxlxlm.SelectSingleNode("//a:Member[@Name='Alarms']")
|
|||
|
If eaoadsNooomrbbsM Is Nothing Then
|
|||
|
MsgBox GetTranslatedMessage("MEMBER_NODE_NOT_FOUND"), vbExclamation
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
Dim yTdayxyTTTeT As String
|
|||
|
yTdayxyTTTeT = eaoadsNooomrbbsM.Attributes.getNamedItem("Datatype").Text
|
|||
|
Dim enrteen As String
|
|||
|
enrteen = "Array\[0\.\.\d+\]"
|
|||
|
Dim mmclatarnae As String
|
|||
|
mmclatarnae = "Array[0.." & (nmumrmumrm - 1) & "]"
|
|||
|
Dim ereeg As Object
|
|||
|
Set ereeg = CreateObject("VBScript.RegExp")
|
|||
|
ereeg.pattern = enrteen
|
|||
|
ereeg.Global = True
|
|||
|
ereeg.IgnoreCase = False
|
|||
|
yTdayxyTTTeT = ereeg.Replace(yTdayxyTTTeT, mmclatarnae)
|
|||
|
eaoadsNooomrbbsM.Attributes.getNamedItem("Datatype").Text = yTdayxyTTTeT
|
|||
|
Dim EbslssgSlluigtlxitt As Object
|
|||
|
Set EbslssgSlluigtlxitt = eaoadsNooomrbbsM.SelectNodes(".//a:Subelement")
|
|||
|
For i = EbslssgSlluigtlxitt.Length - 1 To 0 Step -1
|
|||
|
EbslssgSlluigtlxitt.item(i).ParentNode.RemoveChild EbslssgSlluigtlxitt.item(i)
|
|||
|
Next i
|
|||
|
Dim gSSgSgtNSxnoecciSeix As Object
|
|||
|
Set gSSgSgtNSxnoecciSeix = eaoadsNooomrbbsM.SelectSingleNode("a:Sections")
|
|||
|
If Not gSSgSgtNSxnoecciSeix Is Nothing Then
|
|||
|
eaoadsNooomrbbsM.RemoveChild gSSgSgtNSxnoecciSeix
|
|||
|
End If
|
|||
|
Set eoNNnttoNndt = mxlxlm.createNode(1, "Sections", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|||
|
eaoadsNooomrbbsM.appendChild eoNNnttoNndt
|
|||
|
Set ecceNesNons = mxlxlm.createNode(1, "Section", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|||
|
ecceNesNons.Attributes.setNamedItem(mxlxlm.createAttribute("Name")).Text = "None"
|
|||
|
eoNNnttoNndt.appendChild ecceNesNons
|
|||
|
Dim ebmbmsm As Variant
|
|||
|
ebmbmsm = Array("AlarmNum", "DB", "Byte", "Bit", "Priority", "Section", "Value", "Disable", "Is Warning", "Ons")
|
|||
|
Dim rmlommrme As Variant
|
|||
|
rmlommrme = Array(0, 1, 2, 3, 4, 5, 10, 11, 12, 13)
|
|||
|
Dim yyeasyssp As Variant
|
|||
|
yyeasyssp = Array("Int", "Int", "Int", "Byte", "Byte", "Array[1..""Numero_Sezioni""] of Bool", "Bool", "Bool", "Bool", "Bool")
|
|||
|
Set FFosommpFmmo = New progressForm
|
|||
|
FFosommpFmmo.Show vbModeless
|
|||
|
For i = 0 To UBound(ebmbmsm)
|
|||
|
Set Nmobbrbome = mxlxlm.createNode(1, "Member", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|||
|
Nmobbrbome.Attributes.setNamedItem(mxlxlm.createAttribute("Name")).Text = ebmbmsm(i)
|
|||
|
Nmobbrbome.Attributes.setNamedItem(mxlxlm.createAttribute("Datatype")).Text = yyeasyssp(i)
|
|||
|
ecceNesNons.appendChild Nmobbrbome
|
|||
|
FFosommpFmmo.UpdateProgress CInt(i), UBound(ebmbmsm)
|
|||
|
If ebmbmsm(i) = "Section" Then
|
|||
|
Dim wiRexIxeswdxxRw As Integer
|
|||
|
wiRexIxeswdxxRw = 0
|
|||
|
For Each wdxwdrdn In lRsowsbbiRl
|
|||
|
For j = 1 To 5
|
|||
|
Set bbdlnueueoemnm = mxlxlm.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|||
|
bbdlnueueoemnm.Attributes.setNamedItem(mxlxlm.createAttribute("Path")).Text = wiRexIxeswdxxRw & "," & j
|
|||
|
Set telVuosuValsad = mxlxlm.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|||
|
auecalual = ws.Cells(wdxwdrdn, irniaelmpoiaoi + rmlommrme(i) + j - 1).value
|
|||
|
telVuosuValsad.Text = ExportBool(Trim(auecalual))
|
|||
|
bbdlnueueoemnm.appendChild telVuosuValsad
|
|||
|
Nmobbrbome.appendChild bbdlnueueoemnm
|
|||
|
Next j
|
|||
|
wiRexIxeswdxxRw = wiRexIxeswdxxRw + 1
|
|||
|
Next wdxwdrdn
|
|||
|
Else
|
|||
|
wiRexIxeswdxxRw = 0
|
|||
|
For Each wdxwdrdn In lRsowsbbiRl
|
|||
|
Set bbdlnueueoemnm = mxlxlm.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|||
|
bbdlnueueoemnm.Attributes.setNamedItem(mxlxlm.createAttribute("Path")).Text = CStr(wiRexIxeswdxxRw)
|
|||
|
Set telVuosuValsad = mxlxlm.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|||
|
auecalual = ws.Cells(wdxwdrdn, irniaelmpoiaoi + rmlommrme(i)).value
|
|||
|
Select Case yyeasyssp(i)
|
|||
|
Case "Bool"
|
|||
|
telVuosuValsad.Text = ExportBool(Trim(auecalual))
|
|||
|
Case "Byte"
|
|||
|
telVuosuValsad.Text = ExportByte(auecalual)
|
|||
|
Case "Int"
|
|||
|
telVuosuValsad.Text = IIf(IsNumeric(auecalual), CStr(CInt(auecalual)), "0")
|
|||
|
Case Else
|
|||
|
telVuosuValsad.Text = CStr(auecalual)
|
|||
|
End Select
|
|||
|
bbdlnueueoemnm.appendChild telVuosuValsad
|
|||
|
Nmobbrbome.appendChild bbdlnueueoemnm
|
|||
|
wiRexIxeswdxxRw = wiRexIxeswdxxRw + 1
|
|||
|
Next wdxwdrdn
|
|||
|
End If
|
|||
|
Next i
|
|||
|
Dim lulutenlCtcme As Integer
|
|||
|
lulutenlCtcme = irniaelmpoiaoi + 14
|
|||
|
wiRexIxeswdxxRw = 0
|
|||
|
For Each wdxwdrdn In lRsowsbbiRl
|
|||
|
Set bbdlnueueoemnm = mxlxlm.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|||
|
bbdlnueueoemnm.Attributes.setNamedItem(mxlxlm.createAttribute("Path")).Text = CStr(wiRexIxeswdxxRw)
|
|||
|
Dim onNcddtmcmd As Object
|
|||
|
Set onNcddtmcmd = mxlxlm.createNode(1, "Comment", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|||
|
Dim tTlamnadnxiegxelm As Object
|
|||
|
Set tTlamnadnxiegxelm = mxlxlm.createNode(1, "MultiLanguageText", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|||
|
tTlamnadnxiegxelm.Attributes.setNamedItem(mxlxlm.createAttribute("Lang")).Text = "it-IT"
|
|||
|
tTlamnadnxiegxelm.Text = ws.Cells(wdxwdrdn, lulutenlCtcme).value
|
|||
|
onNcddtmcmd.appendChild tTlamnadnxiegxelm
|
|||
|
bbdlnueueoemnm.appendChild onNcddtmcmd
|
|||
|
eaoadsNooomrbbsM.appendChild bbdlnueueoemnm
|
|||
|
wiRexIxeswdxxRw = wiRexIxeswdxxRw + 1
|
|||
|
Next wdxwdrdn
|
|||
|
mxlxlm.Save htPPilla
|
|||
|
Unload FFosommpFmmo
|
|||
|
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 ipvti As Variant, temp As Variant
|
|||
|
low = first
|
|||
|
high = last
|
|||
|
ipvti = arr((first + last) \ 2)
|
|||
|
Do While low <= high
|
|||
|
Do While arr(low) < ipvti
|
|||
|
low = low + 1
|
|||
|
Loop
|
|||
|
Do While arr(high) > ipvti
|
|||
|
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(auecalual)
|
|||
|
If IsNumeric(auecalual) Then
|
|||
|
decimalValue = CLng(auecalual)
|
|||
|
hexValue = Hex(decimalValue)
|
|||
|
If Len(hexValue) < 2 Then
|
|||
|
hexValue = "0" & hexValue
|
|||
|
End If
|
|||
|
auecalual = "16#" & hexValue
|
|||
|
Else
|
|||
|
auecalual = "16#00"
|
|||
|
End If
|
|||
|
ExportByte = auecalual
|
|||
|
End Function
|
|||
|
Sub MarcarFilasOcultas()
|
|||
|
Dim i As Long
|
|||
|
Dim maMuMMmMmlamM As Long
|
|||
|
Dim irniaelmpoiaoi As Long
|
|||
|
Dim pFmmeFpprre As Long
|
|||
|
irniaelmpoiaoi = 2
|
|||
|
pFmmeFpprre = 5 + 1
|
|||
|
maMuMMmMmlamM = 17
|
|||
|
Set ws = ActiveSheet
|
|||
|
aaltFuimil = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
|||
|
For i = pFmmeFpprre To aaltFuimil
|
|||
|
If ws.Rows(i).Hidden Then
|
|||
|
ws.Cells(i, maMuMMmMmlamM).value = "X"
|
|||
|
Else
|
|||
|
ws.Cells(i, maMuMMmMmlamM).value = ""
|
|||
|
End If
|
|||
|
Next i
|
|||
|
End Sub
|
|||
|
Sub OcultarFilasSegunMarca()
|
|||
|
Dim i As Long
|
|||
|
Dim maMuMMmMmlamM As Long
|
|||
|
Dim irniaelmpoiaoi As Long
|
|||
|
Dim pFmmeFpprre As Long
|
|||
|
Dim aaltFuimil As Long
|
|||
|
Dim ws As Worksheet
|
|||
|
Dim FFosommpFmmo As progressForm
|
|||
|
irniaelmpoiaoi = 2
|
|||
|
pFmmeFpprre = 5
|
|||
|
maMuMMmMmlamM = 17
|
|||
|
Application.ScreenUpdating = False
|
|||
|
Application.Calculation = xlCalculationManual
|
|||
|
Application.EnableEvents = False
|
|||
|
Set ws = ActiveSheet
|
|||
|
ws.Rows.Hidden = False
|
|||
|
aaltFuimil = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
|||
|
Set FFosommpFmmo = New progressForm
|
|||
|
FFosommpFmmo.Show vbModeless
|
|||
|
For i = pFmmeFpprre To aaltFuimil
|
|||
|
If UCase(ws.Cells(i, maMuMMmMmlamM).value) = "X" Then
|
|||
|
ws.Rows(i).Hidden = True
|
|||
|
End If
|
|||
|
If i Mod 10 = 0 Then
|
|||
|
FFosommpFmmo.UpdateProgress i - pFmmeFpprre + 1, aaltFuimil - pFmmeFpprre + 1
|
|||
|
DoEvents
|
|||
|
End If
|
|||
|
Next i
|
|||
|
Unload FFosommpFmmo
|
|||
|
Application.ScreenUpdating = True
|
|||
|
Application.Calculation = xlCalculationAutomatic
|
|||
|
Application.EnableEvents = True
|
|||
|
MsgBox Replace(GetTranslatedMessage("ROWS_HIDDEN"), "{0}", CStr(aaltFuimil - pFmmeFpprre + 1)), vbInformation
|
|||
|
End Sub
|
|||
|
Sub MostrarTodasLasFilas()
|
|||
|
Set ws = ActiveSheet
|
|||
|
ws.Rows.Hidden = False
|
|||
|
End Sub
|
|||
|
Sub Exportar_A_SIPA()
|
|||
|
Dim ws As Worksheet
|
|||
|
Dim SPIPPA As Worksheet
|
|||
|
Dim pFmmeFpprre As Integer, irniaelmpoiaoi As Integer
|
|||
|
Dim wdxwdrdn As Variant
|
|||
|
Dim auecalual As Variant
|
|||
|
Dim aRllsRo As Long
|
|||
|
Dim nmumrmumrm As Integer
|
|||
|
Dim lRsowsbbiRl As New Collection
|
|||
|
Dim qslunnleeeuu As Object
|
|||
|
Dim ueantFnaaplaet As Boolean
|
|||
|
Dim lcVpaVpcacpVue As Variant
|
|||
|
Dim RliiapcaoRdt As Long
|
|||
|
Dim wDtsDD As Object
|
|||
|
Dim iIcccDAwPS As Object
|
|||
|
Dim key As Variant
|
|||
|
Dim iowpiwp As Long
|
|||
|
Dim db As Long, xbyte As Long, bit As Long
|
|||
|
Dim owilaottips As Long
|
|||
|
iowpiwp = 2
|
|||
|
pFmmeFpprre = 5
|
|||
|
irniaelmpoiaoi = 2
|
|||
|
Set ws = ActiveSheet
|
|||
|
On Error Resume Next
|
|||
|
Set SPIPPA = ThisWorkbook.Worksheets("Per Supervisore SIPA")
|
|||
|
On Error GoTo 0
|
|||
|
If SPIPPA Is Nothing Then
|
|||
|
MsgBox GetTranslatedMessage("SIPA_SHEET_NOT_FOUND"), vbExclamation
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
Set qslunnleeeuu = CreateObject("Scripting.Dictionary")
|
|||
|
Set wDtsDD = 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 iIcccDAwPS = CreateDict("Alarm-Warning", 0, "Number", 1, "Tag", 2, "Sections", 3, _
|
|||
|
"Priority", 4, "Description", 5, "Used", 6)
|
|||
|
aRllsRo = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
|||
|
ueantFnaaplaet = False
|
|||
|
For wdxwdrdn = pFmmeFpprre + 1 To aRllsRo
|
|||
|
If Not ws.Rows(wdxwdrdn).Hidden Then
|
|||
|
auecalual = ws.Cells(wdxwdrdn, irniaelmpoiaoi).value
|
|||
|
If Not IsEmpty(auecalual) Then
|
|||
|
If qslunnleeeuu.Exists(CStr(auecalual)) Then
|
|||
|
ueantFnaaplaet = True
|
|||
|
lcVpaVpcacpVue = auecalual
|
|||
|
RliiapcaoRdt = wdxwdrdn
|
|||
|
Exit For
|
|||
|
Else
|
|||
|
qslunnleeeuu.Add CStr(auecalual), wdxwdrdn
|
|||
|
End If
|
|||
|
End If
|
|||
|
End If
|
|||
|
Next wdxwdrdn
|
|||
|
If ueantFnaaplaet Then
|
|||
|
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", lcVpaVpcacpVue), "{1}", RliiapcaoRdt), vbExclamation
|
|||
|
Exit Sub
|
|||
|
End If
|
|||
|
nmumrmumrm = 0
|
|||
|
For wdxwdrdn = pFmmeFpprre + 1 To aRllsRo
|
|||
|
If Not ws.Rows(wdxwdrdn).Hidden Then
|
|||
|
nmumrmumrm = nmumrmumrm + 1
|
|||
|
lRsowsbbiRl.Add wdxwdrdn
|
|||
|
End If
|
|||
|
Next wdxwdrdn
|
|||
|
owilaottips = SPIPPA.Cells(SPIPPA.Rows.Count, 1).End(xlUp).row
|
|||
|
If owilaottips >= iowpiwp Then
|
|||
|
SPIPPA.Rows(iowpiwp & ":" & owilaottips).Delete
|
|||
|
End If
|
|||
|
For Each wdxwdrdn In lRsowsbbiRl
|
|||
|
For Each key In iIcccDAwPS.Keys
|
|||
|
Select Case key
|
|||
|
Case "Alarm-Warning"
|
|||
|
If UCase(ws.Cells(wdxwdrdn, wDtsDD("Is Warning") + irniaelmpoiaoi).value) = "X" Then
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = "Warning"
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).Font.Color = RGB(0, 32, 240)
|
|||
|
Else
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = "Alarm"
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).Font.Color = RGB(255, 0, 0)
|
|||
|
End If
|
|||
|
Case "Number"
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = ws.Cells(wdxwdrdn, wDtsDD("AlarmNum") + irniaelmpoiaoi).value
|
|||
|
Case "Tag"
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = "DB" & ws.Cells(wdxwdrdn, wDtsDD("DB") + irniaelmpoiaoi).value & _
|
|||
|
".DBX" & ws.Cells(wdxwdrdn, wDtsDD("Byte") + irniaelmpoiaoi).value & _
|
|||
|
"." & ws.Cells(wdxwdrdn, wDtsDD("Bit") + irniaelmpoiaoi).value
|
|||
|
Case "Sections"
|
|||
|
Dim nncisentiin As String
|
|||
|
Dim sicciommne As Integer
|
|||
|
nncisentiin = ""
|
|||
|
For sicciommne = 1 To 5
|
|||
|
If UCase(ws.Cells(wdxwdrdn, wDtsDD("Section." & sicciommne) + irniaelmpoiaoi).value) = "X" Then
|
|||
|
If nncisentiin <> "" Then
|
|||
|
nncisentiin = nncisentiin & ","
|
|||
|
End If
|
|||
|
nncisentiin = nncisentiin & sicciommne
|
|||
|
End If
|
|||
|
Next sicciommne
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = nncisentiin
|
|||
|
Case "Priority"
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = ws.Cells(wdxwdrdn, wDtsDD("Priority") + irniaelmpoiaoi).value
|
|||
|
Case "Description"
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = ws.Cells(wdxwdrdn, wDtsDD("Descripci<63>n") + irniaelmpoiaoi).value
|
|||
|
Case "Used"
|
|||
|
If UCase(ws.Cells(wdxwdrdn, wDtsDD("Disable") + irniaelmpoiaoi).value) <> "X" Then
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = ChrW(9679)
|
|||
|
Else
|
|||
|
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = "-"
|
|||
|
End If
|
|||
|
End Select
|
|||
|
Next key
|
|||
|
iowpiwp = iowpiwp + 1
|
|||
|
Next wdxwdrdn
|
|||
|
Dim PenhlPienwe As String
|
|||
|
PenhlPienwe = Application.GetSaveAsFilename(InitialFileName:="Mappa Allarmi Completa Supervisore", _
|
|||
|
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
|
|||
|
Title:="Guardar hoja SIPA como")
|
|||
|
If PenhlPienwe <> "False" Then
|
|||
|
Dim wnnbrerWobn As Workbook
|
|||
|
Set wnnbrerWobn = Application.Workbooks.Add
|
|||
|
SPIPPA.Copy Before:=wnnbrerWobn.Sheets(1)
|
|||
|
Application.DisplayAlerts = False
|
|||
|
wnnbrerWobn.Sheets(2).Delete
|
|||
|
Application.DisplayAlerts = True
|
|||
|
wnnbrerWobn.SaveAs Filename:=PenhlPienwe
|
|||
|
wnnbrerWobn.Close SaveChanges:=True
|
|||
|
MsgBox Replace(GetTranslatedMessage("SIPA_EXPORT_SAVED"), "{0}", PenhlPienwe), 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 tttrpp As Variant
|
|||
|
tttrpp = Split(texto, "/")
|
|||
|
If UBound(tttrpp) >= 0 Then
|
|||
|
GetDB = CLng(tttrpp(0))
|
|||
|
Else
|
|||
|
GetDB = -1
|
|||
|
End If
|
|||
|
End Function
|
|||
|
Function GetByte(texto As String) As Long
|
|||
|
Dim tttrpp As Variant
|
|||
|
tttrpp = Split(texto, "/")
|
|||
|
If UBound(tttrpp) >= 1 Then
|
|||
|
GetByte = CLng(tttrpp(1))
|
|||
|
Else
|
|||
|
GetByte = -1
|
|||
|
End If
|
|||
|
End Function
|
|||
|
Function GetBit(texto As String) As Long
|
|||
|
Dim tttrpp As Variant
|
|||
|
tttrpp = Split(texto, "/")
|
|||
|
If UBound(tttrpp) >= 2 Then
|
|||
|
Dim btiibaa As String
|
|||
|
btiibaa = Split(tttrpp(2), " ")(0)
|
|||
|
GetBit = CLng(btiibaa)
|
|||
|
Else
|
|||
|
GetBit = -1
|
|||
|
End If
|
|||
|
End Function
|
|||
|
Function GetExcelLanguage() As String
|
|||
|
Dim DnDaDl As Long
|
|||
|
DnDaDl = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
|
|||
|
Select Case DnDaDl
|
|||
|
Case 3082, 1034, 11274, 16394, 13322, 9226, 5130, 7178, 12298, 17418, 4106, 18442, 19466, 6154, 15370, 10250, 20490, 21514, 14346, 8202
|
|||
|
GetExcelLanguage = "ES"
|
|||
|
Case 1040, 2064
|
|||
|
GetExcelLanguage = "IT"
|
|||
|
Case 1033, 2057, 3081, 4105, 5129, 6153, 7177, 8201, 9225, 10249, 11273, 12297, 13321, 14345, 15369, 16393, 17417, 18441, 19465, 20489
|
|||
|
GetExcelLanguage = "EN"
|
|||
|
Case 1036, 2060, 3084, 4108, 5132, 6156, 7180, 8204, 9228, 10252, 11276, 12300, 13324, 14348, 15372, 16396, 20484
|
|||
|
GetExcelLanguage = "FR"
|
|||
|
Case 1031, 2055, 3079, 4103, 5127
|
|||
|
GetExcelLanguage = "DE"
|
|||
|
Case 2070, 1046
|
|||
|
GetExcelLanguage = "PT"
|
|||
|
Case Else
|
|||
|
GetExcelLanguage = "EN"
|
|||
|
End Select
|
|||
|
Debug.Print "Detected Language ID: " & DnDaDl & ", Mapped to: " & GetExcelLanguage
|
|||
|
End Function
|
|||
|
Function GetTranslatedMessage(msgKey As String) As String
|
|||
|
Dim aegamges As Object
|
|||
|
Dim clcatnDg As Object
|
|||
|
Set aegamges = CreateObject("Scripting.Dictionary")
|
|||
|
Set clcatnDg = CreateObject("Scripting.Dictionary")
|
|||
|
clcatnDg.Add "IMPORT_COMPLETE", "Import completed."
|
|||
|
clcatnDg.Add "EXPORT_COMPLETE", "Export completed."
|
|||
|
clcatnDg.Add "FILE_NOT_SELECTED", "No file was selected. Operation cancelled."
|
|||
|
clcatnDg.Add "DUPLICATE_VALUE", "A duplicate value was found: {0} in row {1}. The operation has been aborted."
|
|||
|
clcatnDg.Add "ALARM_NODE_NOT_FOUND", "The 'Alarms' node was not found in the XML file."
|
|||
|
clcatnDg.Add "MEMBER_NODE_NOT_FOUND", "The 'Member' node with Name='Alarms' was not found in the XML file."
|
|||
|
clcatnDg.Add "ROWS_HIDDEN", "Process completed. Rows hidden: {0}"
|
|||
|
clcatnDg.Add "ALL_ROWS_SHOWN", "All rows are now visible."
|
|||
|
clcatnDg.Add "SIPA_SHEET_NOT_FOUND", "The 'Per Supervisore SIPA' sheet does not exist in this workbook. Please create this sheet before continuing."
|
|||
|
clcatnDg.Add "SIPA_EXPORT_COMPLETE", "SIPA export completed."
|
|||
|
clcatnDg.Add "SIPA_EXPORT_SAVED", "SIPA export completed and saved in {0}"
|
|||
|
clcatnDg.Add "SIPA_EXPORT_NOT_SAVED", "SIPA export completed. Not saved in a separate file."
|
|||
|
aegamges.Add "EN", clcatnDg
|
|||
|
Set clcatnDg = CreateObject("Scripting.Dictionary")
|
|||
|
clcatnDg.Add "IMPORT_COMPLETE", "Importación completada."
|
|||
|
clcatnDg.Add "EXPORT_COMPLETE", "Exportación completada."
|
|||
|
clcatnDg.Add "FILE_NOT_SELECTED", "No se seleccionó ningún archivo. Operación cancelada."
|
|||
|
clcatnDg.Add "DUPLICATE_VALUE", "Se encontró un valor duplicado: {0} en la fila {1}. La operación ha sido abortada."
|
|||
|
clcatnDg.Add "ALARM_NODE_NOT_FOUND", "No se encontró el nodo 'Alarms' en el archivo XML."
|
|||
|
clcatnDg.Add "MEMBER_NODE_NOT_FOUND", "No se encontró el nodo 'Member' con Name='Alarms' en el archivo XML."
|
|||
|
clcatnDg.Add "ROWS_HIDDEN", "Proceso completado. Filas ocultadas: {0}"
|
|||
|
clcatnDg.Add "ALL_ROWS_SHOWN", "Todas las filas son ahora visibles."
|
|||
|
clcatnDg.Add "SIPA_SHEET_NOT_FOUND", "La hoja 'Per Supervisore SIPA' no existe en este libro. Por favor, cree esta hoja antes de continuar."
|
|||
|
clcatnDg.Add "SIPA_EXPORT_COMPLETE", "Exportación a SIPA completada."
|
|||
|
clcatnDg.Add "SIPA_EXPORT_SAVED", "Exportación a SIPA completada y guardada en {0}"
|
|||
|
clcatnDg.Add "SIPA_EXPORT_NOT_SAVED", "Exportación a SIPA completada. No se ha guardado en un archivo separado."
|
|||
|
aegamges.Add "ES", clcatnDg
|
|||
|
Set clcatnDg = CreateObject("Scripting.Dictionary")
|
|||
|
clcatnDg.Add "IMPORT_COMPLETE", "Importazione completata."
|
|||
|
clcatnDg.Add "EXPORT_COMPLETE", "Esportazione completata."
|
|||
|
clcatnDg.Add "FILE_NOT_SELECTED", "Nessun file selezionato. Operazione annullata."
|
|||
|
clcatnDg.Add "DUPLICATE_VALUE", "È stato trovato un valore duplicato: {0} nella riga {1}. L'operazione è stata interrotta."
|
|||
|
clcatnDg.Add "ALARM_NODE_NOT_FOUND", "Il nodo 'Alarms' non è stato trovato nel file XML."
|
|||
|
clcatnDg.Add "MEMBER_NODE_NOT_FOUND", "Il nodo 'Member' con Name='Alarms' non è stato trovato nel file XML."
|
|||
|
clcatnDg.Add "ROWS_HIDDEN", "Processo completato. Righe nascoste: {0}"
|
|||
|
clcatnDg.Add "ALL_ROWS_SHOWN", "Tutte le righe sono ora visibili."
|
|||
|
clcatnDg.Add "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."
|
|||
|
clcatnDg.Add "SIPA_EXPORT_COMPLETE", "Esportazione SIPA completata."
|
|||
|
clcatnDg.Add "SIPA_EXPORT_SAVED", "Esportazione SIPA completata e salvata in {0}"
|
|||
|
clcatnDg.Add "SIPA_EXPORT_NOT_SAVED", "Esportazione SIPA completata. Non salvata in un file separato."
|
|||
|
aegamges.Add "IT", clcatnDg
|
|||
|
Dim lang As String
|
|||
|
lang = GetExcelLanguage()
|
|||
|
If aegamges.Exists(lang) And aegamges(lang).Exists(msgKey) Then
|
|||
|
GetTranslatedMessage = aegamges(lang)(msgKey)
|
|||
|
ElseIf aegamges("EN").Exists(msgKey) Then
|
|||
|
GetTranslatedMessage = aegamges("EN")(msgKey)
|
|||
|
Else
|
|||
|
GetTranslatedMessage = "Message not found: " & msgKey
|
|||
|
End If
|
|||
|
End Function
|