1183 lines
45 KiB
QBasic
1183 lines
45 KiB
QBasic
Attribute VB_Name = "Funciones"
|
||
' dev Miguel Vera 2024 v0.5
|
||
|
||
Sub ImportSiemensXML()
|
||
Dim xmlDoc As Object
|
||
Dim xmlNode As Object
|
||
Dim alarmNode As Object
|
||
Dim alarmArray As Object
|
||
Dim i As Integer, j As Integer
|
||
Dim ws As Worksheet
|
||
Dim filePath As String
|
||
|
||
Dim primeraFila As Long, primeraColumna As Long
|
||
Dim subElements As Object
|
||
Dim subElement As Object
|
||
Dim pathParts() As String
|
||
Dim rowIndex As Integer
|
||
Dim colIndex As Integer
|
||
Dim memberName As String
|
||
Dim memberDataType As String
|
||
Dim colOffset As Integer
|
||
Dim s As Integer
|
||
Dim maxSectionIndex As Integer
|
||
Dim sectionIndex As Integer
|
||
Dim startValue As String
|
||
Dim description As String
|
||
Dim descriptionNode As Object
|
||
Dim creationDate As Date
|
||
Dim currentDate As Date
|
||
Dim fechaBase
|
||
Dim crearTitulos As Boolean
|
||
Dim lastRow As Long
|
||
Dim newRowIndex As Long
|
||
Dim path As String
|
||
|
||
primeraFila = 5
|
||
primeraColumna = 2
|
||
fechaBase = 2020
|
||
crearTitulos = False
|
||
|
||
' Pedir al usuario que seleccione el archivo XML
|
||
filePath = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML")
|
||
|
||
' Verificar si se seleccion<6F> un archivo
|
||
If filePath = "False" Or filePath = "Falso" Then
|
||
Exit Sub
|
||
End If
|
||
|
||
|
||
' Obtener la fecha actual
|
||
currentDate = Date
|
||
|
||
' Verificar si la fecha actual es mayor al 31 de diciembre de 2024
|
||
If currentDate > DateSerial(fechaBase + 4, 12, 31) Then
|
||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||
Exit Sub
|
||
End If
|
||
|
||
' Obtener la fecha de creaci<63>n del archivo desde el sistema de archivos
|
||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||
Set file = fso.GetFile(filePath)
|
||
creationDate = file.DateCreated
|
||
|
||
' Verificar si la fecha de creaci<63>n es posterior al 31 de diciembre de 2024
|
||
If creationDate > DateSerial(fechaBase + 4, 12, 31) Then
|
||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||
Exit Sub
|
||
End If
|
||
|
||
Set ws = ActiveSheet
|
||
|
||
' Mostrar todas las filas antes de comenzar la importaci<63>n
|
||
ws.Rows.Hidden = False
|
||
|
||
' Obtener la <20>ltima fila con datos en la hoja
|
||
lastRow = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||
|
||
' Cargar el archivo XML
|
||
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
|
||
xmlDoc.async = False
|
||
xmlDoc.Load (filePath)
|
||
xmlDoc.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
||
|
||
' Buscar el nodo "Alarms"
|
||
Set alarmNode = xmlDoc.SelectSingleNode("//a:Member[@Name='Alarms']")
|
||
|
||
' Verificar si se encontr<74> el nodo
|
||
If alarmNode Is Nothing Then
|
||
MsgBox GetTranslatedMessage("ALARM_NODE_NOT_FOUND"), vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
' Obtener los miembros del array "Alarms"
|
||
Set alarmArray = alarmNode.SelectNodes("a:Sections/a:Section/a:Member")
|
||
|
||
|
||
' Nuevo: Declarar la tabla de alarmas
|
||
'
|
||
Dim alarmTable As Object
|
||
Set alarmTable = CreateObject("Scripting.Dictionary")
|
||
' Nuevo: Crear la tabla de alarmas
|
||
CreateAlarmTable alarmNode, alarmTable, ws, primeraColumna
|
||
|
||
|
||
' Inicializar el desplazamiento de columna
|
||
colOffset = primeraColumna
|
||
|
||
' Crear una lista para almacenar los nombres de las columnas
|
||
Dim columnNames As Collection
|
||
Set columnNames = New Collection
|
||
|
||
' Deshabilitar actualizaciones y c<>lculos
|
||
Application.ScreenUpdating = False
|
||
Application.Calculation = xlCalculationManual
|
||
Application.EnableEvents = False
|
||
|
||
' Crear y mostrar el formulario de progreso
|
||
Set progressForm = New progressForm
|
||
progressForm.Show vbModeless
|
||
|
||
' Iterar sobre los miembros del array
|
||
For i = 0 To alarmArray.Length - 1
|
||
memberName = alarmArray.item(i).Attributes.getNamedItem("Name").Text
|
||
memberDataType = alarmArray.item(i).Attributes.getNamedItem("Datatype").Text
|
||
|
||
' Actualizar el progreso cada 10 filas (puedes ajustar este n<>mero)
|
||
If i Mod 10 = 0 Then
|
||
progressForm.UpdateProgress CInt(i), alarmArray.Length
|
||
DoEvents
|
||
End If
|
||
|
||
If memberName = "Section" Then
|
||
' Obtener los subelementos
|
||
Set subElements = alarmArray.item(i).SelectNodes("a:Subelement")
|
||
|
||
' Determinar el n<>mero m<>ximo de secciones
|
||
maxSectionIndex = 0
|
||
For Each subElement In subElements
|
||
' Obtener el atributo "Path"
|
||
pathParts = Split(subElement.Attributes.getNamedItem("Path").Text, ",")
|
||
If UBound(pathParts) >= 1 Then
|
||
sectionIndex = CInt(pathParts(1))
|
||
If sectionIndex > maxSectionIndex Then
|
||
maxSectionIndex = sectionIndex
|
||
End If
|
||
End If
|
||
Next subElement
|
||
|
||
If crearTitulos Then
|
||
' Crear columnas seg<65>n el n<>mero m<>ximo de secciones
|
||
For s = 1 To maxSectionIndex
|
||
ws.Cells(primeraFila, colOffset + s - 1).value = "Section." & s
|
||
columnNames.Add "Section." & s
|
||
Next s
|
||
End If
|
||
|
||
' Escribir los valores en las celdas correspondientes
|
||
For Each subElement In subElements
|
||
path = subElement.Attributes.getNamedItem("Path").Text
|
||
pathParts = Split(path, ",")
|
||
|
||
' Usar la tabla de alarmas para determinar rowIndex
|
||
If alarmTable.Exists(CStr(CInt(pathParts(0)))) Then
|
||
rowIndex = alarmTable(CStr(CInt(pathParts(0))))("searchRowIndex")
|
||
If rowIndex >= 0 Then ' S<>lo procesar si rowIndex es positivo
|
||
If rowIndex = 0 Then
|
||
' Si no se encontr<74> en la hoja, agregar una nueva fila al final
|
||
lastRow = lastRow + 1
|
||
rowIndex = lastRow
|
||
ws.Cells(rowIndex, primeraColumna).value = CInt(pathParts(0))
|
||
alarmTable(CStr(CInt(pathParts(0))))("searchRowIndex") = rowIndex
|
||
End If
|
||
|
||
' Calcular el <20>ndice de columna
|
||
sectionIndex = CInt(pathParts(1))
|
||
colIndex = colOffset + sectionIndex - 1
|
||
|
||
' Obtener "StartValue"
|
||
startValue = subElement.SelectSingleNode("a:StartValue").Text
|
||
|
||
' Escribir "X" o dejar vac<61>o seg<65>n el valor booleano
|
||
ws.Cells(rowIndex, colIndex).value = ImportBool(startValue)
|
||
End If
|
||
End If
|
||
Next subElement
|
||
|
||
' Actualizar el desplazamiento de columna
|
||
colOffset = colOffset + maxSectionIndex
|
||
Else
|
||
' Procesar otros miembros usando la tabla de alarmas
|
||
Set subElements = alarmArray.item(i).SelectNodes("a:Subelement")
|
||
For j = 0 To subElements.Length - 1
|
||
path = subElements.item(j).Attributes.getNamedItem("Path").Text
|
||
|
||
' Usar la tabla de alarmas para determinar rowIndex
|
||
If alarmTable.Exists(path) Then
|
||
rowIndex = alarmTable(path)("searchRowIndex")
|
||
If rowIndex >= 0 Then ' S<>lo procesar si rowIndex es positivo
|
||
If rowIndex = 0 Then
|
||
' Si no se encontr<74> en la hoja, agregar una nueva fila al final
|
||
lastRow = lastRow + 1
|
||
rowIndex = lastRow
|
||
ws.Cells(rowIndex, primeraColumna).value = alarmTable(path)("AlarmNumStartValue")
|
||
alarmTable(path)("searchRowIndex") = rowIndex
|
||
End If
|
||
|
||
' Obtener "StartValue"
|
||
startValue = subElements.item(j).SelectSingleNode("a:StartValue").Text
|
||
|
||
' Escribir el valor en la celda correspondiente
|
||
If InStr(memberDataType, "Bool") > 0 Then
|
||
ws.Cells(rowIndex, colOffset).value = ImportBool(startValue)
|
||
ElseIf InStr(memberDataType, "Byte") > 0 Then
|
||
ws.Cells(rowIndex, colOffset).value = ImportByte(startValue)
|
||
Else
|
||
ws.Cells(rowIndex, colOffset).value = startValue
|
||
End If
|
||
End If
|
||
End If
|
||
Next j
|
||
|
||
' Actualizar el desplazamiento de columna
|
||
colOffset = colOffset + 1
|
||
End If
|
||
Next i
|
||
If crearTitulos Then
|
||
' A<>adir la columna para las descripciones
|
||
ws.Cells(primeraFila, colOffset).value = "Descripci<63>n"
|
||
End If
|
||
|
||
' Obtener los subelementos directamente bajo "Alarms"
|
||
Set subElements = alarmNode.SelectNodes("a:Subelement")
|
||
|
||
' Obtener el n<>mero de alarmas (filas)
|
||
Dim numAlarmas As Integer
|
||
numAlarmas = subElements.Length
|
||
|
||
' Escribir las descripciones en la <20>ltima columna
|
||
For j = 0 To subElements.Length - 1
|
||
path = subElements.item(j).Attributes.getNamedItem("Path").Text
|
||
|
||
' Actualizar el progreso cada 10 filas (puedes ajustar este n<>mero)
|
||
If i Mod 10 = 0 Then
|
||
progressForm.UpdateProgress CInt(j), subElements.Length - 1
|
||
DoEvents
|
||
End If
|
||
|
||
' Usar la tabla de alarmas para determinar rowIndex
|
||
If alarmTable.Exists(path) Then
|
||
rowIndex = alarmTable(path)("searchRowIndex")
|
||
If rowIndex >= 0 Then ' S<>lo procesar si rowIndex es 0 o positivo
|
||
' Obtener el nodo de descripci<63>n para cada alarma
|
||
Set descriptionNode = subElements.item(j).SelectSingleNode("a:Comment/a:MultiLanguageText")
|
||
If Not descriptionNode Is Nothing Then
|
||
description = descriptionNode.Text
|
||
Else
|
||
description = ""
|
||
End If
|
||
|
||
' Escribir la descripci<63>n en la celda correspondiente
|
||
ws.Cells(rowIndex, colOffset).value = description
|
||
End If
|
||
End If
|
||
Next j
|
||
|
||
' Ordenar las filas bas<61>ndose en la columna primeraColumna
|
||
Dim rng As Range
|
||
Set rng = ws.Range(ws.Cells(primeraFila + 1, 1), ws.Cells(lastRow, ws.UsedRange.Columns.Count))
|
||
rng.Sort Key1:=ws.Cells(primeraFila + 1, primeraColumna), Order1:=xlAscending, Header:=xlNo
|
||
|
||
' Ocultar las filas que no est<73>n en alarmTable
|
||
Dim row As Long
|
||
Dim alarmNumCol As Long
|
||
Dim alarmNum As String
|
||
Dim visibleRows As New Collection
|
||
|
||
' Encontrar la columna del AlarmNum (que deber<65>a ser primeraColumna)
|
||
alarmNumCol = primeraColumna
|
||
|
||
' Crear una colecci<63>n de filas visibles basada en alarmTable
|
||
Dim key As Variant
|
||
For Each key In alarmTable.Keys
|
||
If alarmTable(key)("searchRowIndex") <> 0 Then
|
||
On Error Resume Next
|
||
visibleRows.Add alarmTable(key)("searchRowIndex"), CStr(alarmTable(key)("searchRowIndex"))
|
||
On Error GoTo 0
|
||
End If
|
||
Next key
|
||
|
||
' Ocultar filas que no est<73>n en la colecci<63>n de filas visibles
|
||
For row = primeraFila + 1 To lastRow
|
||
alarmNum = CStr(ws.Cells(row, alarmNumCol).value)
|
||
On Error Resume Next
|
||
If IsEmpty(visibleRows(CStr(row))) Then
|
||
ws.Rows(row).Hidden = True
|
||
End If
|
||
On Error GoTo 0
|
||
Next row
|
||
|
||
' Cerrar el formulario de progreso
|
||
Unload progressForm
|
||
|
||
' Restaurar configuraciones
|
||
Application.ScreenUpdating = True
|
||
Application.Calculation = xlCalculationAutomatic
|
||
Application.EnableEvents = True
|
||
|
||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||
End Sub
|
||
|
||
Sub CreateAlarmTable(alarmNode As Object, alarmTable As Object, ws As Worksheet, primeraColumna As Long)
|
||
Dim alarmNumNode As Object
|
||
Dim subElements As Object
|
||
Dim subElement As Object
|
||
Dim startValue As String
|
||
Dim path As String
|
||
Dim searchRowIndex As Long
|
||
|
||
' Encontrar el nodo AlarmNum
|
||
Set alarmNumNode = alarmNode.SelectSingleNode("a:Sections/a:Section/a:Member[@Name='AlarmNum']")
|
||
|
||
If Not alarmNumNode Is Nothing Then
|
||
Set subElements = alarmNumNode.SelectNodes("a:Subelement")
|
||
|
||
For Each subElement In subElements
|
||
startValue = subElement.SelectSingleNode("a:StartValue").Text
|
||
path = subElement.Attributes.getNamedItem("Path").Text
|
||
|
||
' Asignar -1 si StartValue es 0, de lo contrario buscar el <20>ndice de fila
|
||
If startValue = "0" Then
|
||
searchRowIndex = -1
|
||
Else
|
||
searchRowIndex = FindRowIndex(ws, primeraColumna, startValue)
|
||
End If
|
||
|
||
' Agregar a la tabla de alarmas
|
||
alarmTable.Add path, CreateObject("Scripting.Dictionary")
|
||
alarmTable(path).Add "AlarmNumStartValue", startValue
|
||
alarmTable(path).Add "AlarmNumPath", path
|
||
alarmTable(path).Add "searchRowIndex", searchRowIndex
|
||
Next subElement
|
||
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 lastRow As Long
|
||
Dim i As Long
|
||
|
||
lastRow = ws.Cells(ws.Rows.Count, column).End(xlUp).row
|
||
|
||
For i = 1 To lastRow
|
||
If CStr(ws.Cells(i, column).value) = value Then
|
||
FindRowIndex = i
|
||
Exit Function
|
||
End If
|
||
Next i
|
||
|
||
' Si no se encuentra, devolver 0
|
||
FindRowIndex = 0
|
||
End Function
|
||
|
||
' Y a<>ade esta funci<63>n en tu m<>dulo de VBA:
|
||
Function FindColumnIndex(ws As Worksheet, columnName As String, headerRow As Long, startColumn As Long) As Long
|
||
Dim col As Integer
|
||
Dim lastColumn As Integer
|
||
|
||
lastColumn = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).column
|
||
|
||
For col = startColumn To lastColumn
|
||
If ws.Cells(headerRow, col).value = columnName Then
|
||
FindColumnIndex = col
|
||
Exit Function
|
||
End If
|
||
Next col
|
||
|
||
' Si no se encuentra la columna, devolver 0 o manejar el error como prefieras
|
||
FindColumnIndex = 0
|
||
End Function
|
||
|
||
Function FindRowByAlarmNum(ws As Worksheet, alarmNum As Integer, primeraFila As Integer, primeraColumna As Integer) As Integer
|
||
Dim lastRow As Integer
|
||
Dim i As Integer
|
||
|
||
lastRow = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||
|
||
For i = primeraFila + 1 To lastRow
|
||
If ws.Cells(i, primeraColumna).value = alarmNum Then
|
||
FindRowByAlarmNum = i
|
||
Exit Function
|
||
End If
|
||
Next i
|
||
|
||
FindRowByAlarmNum = 0 ' No se encontr<74> la fila
|
||
End Function
|
||
|
||
Function ImportBool(startValue As String) As String
|
||
ImportBool = IIf(UCase(startValue) = "TRUE", "X", "")
|
||
End Function
|
||
|
||
Function ImportByte(startValue As String) As String
|
||
If Left(startValue, 3) = "16#" Then
|
||
ImportByte = CInt("&H" & Mid(startValue, 4))
|
||
Else
|
||
ImportByte = startValue
|
||
End If
|
||
End Function
|
||
|
||
Sub ExportSiemensXML()
|
||
Dim xmlDoc As Object
|
||
Dim xmlNode As Object
|
||
Dim alarmsMemberNode As Object
|
||
Dim i As Long, j As Long
|
||
Dim ws As Worksheet
|
||
Dim filePath As String
|
||
|
||
Dim primeraFila As Integer, primeraColumna As Integer
|
||
Dim rowIndex As Variant
|
||
Dim colIndex As Integer
|
||
Dim memberName As String
|
||
Dim memberDataType As String
|
||
Dim cellValue As Variant
|
||
Dim startValueNode As Object
|
||
Dim creationDate As Date
|
||
Dim currentDate As Date
|
||
Dim fso As Object
|
||
Dim file As Object
|
||
Dim fechaBase As Integer
|
||
Dim numAlarmas As Integer
|
||
Dim sectionsNode As Object
|
||
Dim sectionNode As Object
|
||
Dim memberNode As Object
|
||
Dim subElementNode As Object
|
||
Dim visibleRows As New Collection
|
||
Dim uniqueValues As Object
|
||
Set uniqueValues = CreateObject("Scripting.Dictionary")
|
||
Dim duplicateFound As Boolean
|
||
Dim duplicateValue As Variant
|
||
Dim duplicateRow As Long
|
||
|
||
primeraFila = 5
|
||
primeraColumna = 2
|
||
fechaBase = 2020
|
||
|
||
' Pedir al usuario que seleccione el archivo XML
|
||
filePath = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML para exportar")
|
||
|
||
' Verificar si se seleccion<6F> un archivo
|
||
If filePath = "False" Or filePath = "Falso" Then
|
||
Exit Sub
|
||
End If
|
||
|
||
' Obtener la fecha actual
|
||
currentDate = Date
|
||
|
||
' Verificar si la fecha actual es mayor al 31 de diciembre de 2024
|
||
If currentDate > DateSerial(fechaBase + 4, 12, 31) Then
|
||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||
Exit Sub
|
||
End If
|
||
|
||
' Obtener la fecha de creaci<63>n del archivo desde el sistema de archivos
|
||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||
Set file = fso.GetFile(filePath)
|
||
creationDate = file.DateCreated
|
||
|
||
' Verificar si la fecha de creaci<63>n es posterior al 31 de diciembre de 2024
|
||
If creationDate > DateSerial(fechaBase + 4, 12, 31) Then
|
||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||
Exit Sub
|
||
End If
|
||
|
||
Set ws = ActiveSheet
|
||
|
||
' Verificar valores <20>nicos en la columna primeraColumna
|
||
lastRow = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||
duplicateFound = False
|
||
|
||
For rowIndex = primeraFila + 1 To lastRow
|
||
If Not ws.Rows(rowIndex).Hidden Then
|
||
cellValue = ws.Cells(rowIndex, primeraColumna).value
|
||
|
||
If Not IsEmpty(cellValue) Then
|
||
If uniqueValues.Exists(CStr(cellValue)) Then
|
||
duplicateFound = True
|
||
duplicateValue = cellValue
|
||
duplicateRow = rowIndex
|
||
Exit For
|
||
Else
|
||
uniqueValues.Add CStr(cellValue), rowIndex
|
||
End If
|
||
End If
|
||
End If
|
||
Next rowIndex
|
||
|
||
If duplicateFound Then
|
||
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", duplicateValue), "{1}", duplicateRow), vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
' Calcular el n<>mero de alarmas considerando solo las filas visibles
|
||
numAlarmas = 0
|
||
For rowIndex = primeraFila + 1 To lastRow
|
||
If Not ws.Rows(rowIndex).Hidden Then
|
||
numAlarmas = numAlarmas + 1
|
||
visibleRows.Add rowIndex
|
||
End If
|
||
Next rowIndex
|
||
|
||
' Cargar el archivo XML
|
||
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
|
||
xmlDoc.async = False
|
||
xmlDoc.Load (filePath)
|
||
xmlDoc.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
||
|
||
' Buscar el nodo "Member" con Name="Alarms"
|
||
Set alarmsMemberNode = xmlDoc.SelectSingleNode("//a:Member[@Name='Alarms']")
|
||
|
||
' Verificar si se encontr<74> el nodo
|
||
If alarmsMemberNode Is Nothing Then
|
||
MsgBox GetTranslatedMessage("MEMBER_NODE_NOT_FOUND"), vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
' Actualizar el tama<6D>o del array en el XML
|
||
' Obtener el valor actual del atributo Datatype
|
||
Dim datatypeText As String
|
||
datatypeText = alarmsMemberNode.Attributes.getNamedItem("Datatype").Text
|
||
|
||
' Reemplazar el tama<6D>o del array con el n<>mero de alarmas menos uno (porque empieza en 0)
|
||
Dim pattern As String
|
||
pattern = "Array\[0\.\.\d+\]"
|
||
Dim replacement As String
|
||
replacement = "Array[0.." & (numAlarmas - 1) & "]"
|
||
Dim regex As Object
|
||
Set regex = CreateObject("VBScript.RegExp")
|
||
regex.pattern = pattern
|
||
regex.Global = True
|
||
regex.IgnoreCase = False
|
||
|
||
datatypeText = regex.Replace(datatypeText, replacement)
|
||
|
||
' Actualizar el atributo Datatype
|
||
alarmsMemberNode.Attributes.getNamedItem("Datatype").Text = datatypeText
|
||
|
||
' Eliminar todos los nodos "Subelement" existentes
|
||
Dim existingSubElements As Object
|
||
Set existingSubElements = alarmsMemberNode.SelectNodes(".//a:Subelement")
|
||
For i = existingSubElements.Length - 1 To 0 Step -1
|
||
existingSubElements.item(i).ParentNode.RemoveChild existingSubElements.item(i)
|
||
Next i
|
||
|
||
' Eliminar la secci<63>n "Sections" existente bajo "Alarms"
|
||
Dim existingSectionsNode As Object
|
||
Set existingSectionsNode = alarmsMemberNode.SelectSingleNode("a:Sections")
|
||
If Not existingSectionsNode Is Nothing Then
|
||
alarmsMemberNode.RemoveChild existingSectionsNode
|
||
End If
|
||
|
||
' Crear el nodo "Sections"
|
||
Set sectionsNode = xmlDoc.createNode(1, "Sections", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
alarmsMemberNode.appendChild sectionsNode
|
||
|
||
' Crear el nodo "Section" con Name="None"
|
||
Set sectionNode = xmlDoc.createNode(1, "Section", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
sectionNode.Attributes.setNamedItem(xmlDoc.createAttribute("Name")).Text = "None"
|
||
sectionsNode.appendChild sectionNode
|
||
|
||
' Definir los miembros y sus tipos de datos
|
||
Dim members As Variant
|
||
members = Array("AlarmNum", "DB", "Byte", "Bit", "Priority", "Section", "Value", "Disable", "Is Warning", "Ons")
|
||
Dim memberCol As Variant
|
||
memberCol = Array(0, 1, 2, 3, 4, 5, 10, 11, 12, 13)
|
||
|
||
Dim dataTypes As Variant
|
||
dataTypes = Array("Int", "Int", "Int", "Byte", "Byte", "Array[1..""Numero_Sezioni""] of Bool", "Bool", "Bool", "Bool", "Bool")
|
||
|
||
' Crear y mostrar el formulario de progreso
|
||
Set progressForm = New progressForm
|
||
progressForm.Show vbModeless
|
||
|
||
' Crear los miembros
|
||
For i = 0 To UBound(members)
|
||
Set memberNode = xmlDoc.createNode(1, "Member", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
memberNode.Attributes.setNamedItem(xmlDoc.createAttribute("Name")).Text = members(i)
|
||
memberNode.Attributes.setNamedItem(xmlDoc.createAttribute("Datatype")).Text = dataTypes(i)
|
||
sectionNode.appendChild memberNode
|
||
|
||
' Actualizar el progreso cada 10 filas (puedes ajustar este n<>mero)
|
||
progressForm.UpdateProgress CInt(i), UBound(members)
|
||
|
||
' Para cada miembro, crear los subelementos basados en los datos de Excel
|
||
If members(i) = "Section" Then
|
||
' Manejar el caso especial de "Section"
|
||
Dim visibleRowIndex As Integer
|
||
visibleRowIndex = 0
|
||
For Each rowIndex In visibleRows
|
||
For j = 1 To 5 ' Asumimos 5 secciones
|
||
Set subElementNode = xmlDoc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
subElementNode.Attributes.setNamedItem(xmlDoc.createAttribute("Path")).Text = visibleRowIndex & "," & j
|
||
|
||
Set startValueNode = xmlDoc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
cellValue = ws.Cells(rowIndex, primeraColumna + memberCol(i) + j - 1).value
|
||
startValueNode.Text = ExportBool(Trim(cellValue))
|
||
|
||
subElementNode.appendChild startValueNode
|
||
memberNode.appendChild subElementNode
|
||
Next j
|
||
visibleRowIndex = visibleRowIndex + 1
|
||
Next rowIndex
|
||
Else
|
||
' Manejar los otros miembros
|
||
visibleRowIndex = 0
|
||
For Each rowIndex In visibleRows
|
||
Set subElementNode = xmlDoc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
subElementNode.Attributes.setNamedItem(xmlDoc.createAttribute("Path")).Text = CStr(visibleRowIndex)
|
||
|
||
Set startValueNode = xmlDoc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
cellValue = ws.Cells(rowIndex, primeraColumna + memberCol(i)).value
|
||
|
||
Select Case dataTypes(i)
|
||
Case "Bool"
|
||
startValueNode.Text = ExportBool(Trim(cellValue))
|
||
Case "Byte"
|
||
startValueNode.Text = ExportByte(cellValue)
|
||
Case "Int"
|
||
startValueNode.Text = IIf(IsNumeric(cellValue), CStr(CInt(cellValue)), "0")
|
||
Case Else
|
||
startValueNode.Text = CStr(cellValue)
|
||
End Select
|
||
|
||
subElementNode.appendChild startValueNode
|
||
memberNode.appendChild subElementNode
|
||
visibleRowIndex = visibleRowIndex + 1
|
||
Next rowIndex
|
||
End If
|
||
Next i
|
||
|
||
' A<>adir los comentarios
|
||
Dim commentColumn As Integer
|
||
commentColumn = primeraColumna + 14
|
||
|
||
visibleRowIndex = 0
|
||
For Each rowIndex In visibleRows
|
||
Set subElementNode = xmlDoc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
subElementNode.Attributes.setNamedItem(xmlDoc.createAttribute("Path")).Text = CStr(visibleRowIndex)
|
||
|
||
Dim commentNode As Object
|
||
Set commentNode = xmlDoc.createNode(1, "Comment", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
|
||
Dim multiLangTextNode As Object
|
||
Set multiLangTextNode = xmlDoc.createNode(1, "MultiLanguageText", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||
multiLangTextNode.Attributes.setNamedItem(xmlDoc.createAttribute("Lang")).Text = "it-IT"
|
||
multiLangTextNode.Text = ws.Cells(rowIndex, commentColumn).value
|
||
|
||
commentNode.appendChild multiLangTextNode
|
||
subElementNode.appendChild commentNode
|
||
alarmsMemberNode.appendChild subElementNode
|
||
visibleRowIndex = visibleRowIndex + 1
|
||
Next rowIndex
|
||
|
||
' Guardar el archivo XML actualizado
|
||
xmlDoc.Save filePath
|
||
|
||
' Cerrar el formulario de progreso
|
||
Unload progressForm
|
||
|
||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||
End Sub
|
||
|
||
' Funci<63>n para verificar si un elemento existe en una colecci<63>n
|
||
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
|
||
|
||
' Funci<63>n para obtener el <20>ndice de un valor en un array
|
||
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 ' No encontrado
|
||
End Function
|
||
|
||
' Procedimiento para ordenar un array de strings (QuickSort)
|
||
Sub QuickSort(arr As Variant, first As Long, last As Long)
|
||
Dim low As Long, high As Long
|
||
Dim pivot As Variant, temp As Variant
|
||
|
||
low = first
|
||
high = last
|
||
pivot = arr((first + last) \ 2)
|
||
|
||
Do While low <= high
|
||
Do While arr(low) < pivot
|
||
low = low + 1
|
||
Loop
|
||
Do While arr(high) > pivot
|
||
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)
|
||
' Escribir "X" o dejar vac<61>o seg<65>n el valor booleano
|
||
ExportBool = "FALSE"
|
||
If UCase(excelValue) = "X" Or UCase(excelValue) = "TRUE" Or UCase(excelValue) = "1" Then
|
||
ExportBool = "TRUE"
|
||
End If
|
||
End Function
|
||
|
||
Function ExportByte(cellValue)
|
||
' Es Byte, convertir de decimal a hexadecimal en formato "16#xx"
|
||
If IsNumeric(cellValue) Then
|
||
decimalValue = CLng(cellValue)
|
||
' Convertir a hexadecimal
|
||
hexValue = Hex(decimalValue)
|
||
' Asegurarse de que tenga dos d<>gitos
|
||
If Len(hexValue) < 2 Then
|
||
hexValue = "0" & hexValue
|
||
End If
|
||
' Formatear en "16#xx"
|
||
cellValue = "16#" & hexValue
|
||
Else
|
||
' Si no es num<75>rico, asignar un valor por defecto o manejar el error
|
||
cellValue = "16#00"
|
||
End If
|
||
ExportByte = cellValue
|
||
End Function
|
||
|
||
Sub MarcarFilasOcultas()
|
||
Dim i As Long
|
||
Dim columnaMarcar As Long
|
||
Dim primeraColumna As Long
|
||
Dim primeraFila As Long
|
||
|
||
primeraColumna = 2
|
||
primeraFila = 5 + 1
|
||
columnaMarcar = 17
|
||
|
||
Set ws = ActiveSheet
|
||
' Verificar valores <20>nicos en la columna primeraColumna
|
||
ultimaFila = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||
|
||
For i = primeraFila To ultimaFila
|
||
If ws.Rows(i).Hidden Then
|
||
ws.Cells(i, columnaMarcar).value = "X"
|
||
Else
|
||
ws.Cells(i, columnaMarcar).value = ""
|
||
End If
|
||
Next i
|
||
End Sub
|
||
|
||
Sub OcultarFilasSegunMarca()
|
||
Dim i As Long
|
||
Dim columnaMarcar As Long
|
||
Dim primeraColumna As Long
|
||
Dim primeraFila As Long
|
||
Dim ultimaFila As Long
|
||
Dim ws As Worksheet
|
||
Dim progressForm As progressForm
|
||
|
||
primeraColumna = 2
|
||
primeraFila = 5
|
||
columnaMarcar = 17
|
||
|
||
|
||
' Deshabilitar actualizaciones y c<>lculos
|
||
Application.ScreenUpdating = False
|
||
Application.Calculation = xlCalculationManual
|
||
Application.EnableEvents = False
|
||
|
||
Set ws = ActiveSheet
|
||
' Mostrar todas las filas antes de comenzar la importaci<63>n
|
||
ws.Rows.Hidden = False
|
||
' Verificar valores <20>nicos en la columna primeraColumna
|
||
ultimaFila = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||
|
||
' Crear y mostrar el formulario de progreso
|
||
Set progressForm = New progressForm
|
||
progressForm.Show vbModeless
|
||
|
||
For i = primeraFila To ultimaFila
|
||
If UCase(ws.Cells(i, columnaMarcar).value) = "X" Then
|
||
ws.Rows(i).Hidden = True
|
||
End If
|
||
|
||
' Actualizar el progreso cada 10 filas (puedes ajustar este n<>mero)
|
||
If i Mod 10 = 0 Then
|
||
progressForm.UpdateProgress i - primeraFila + 1, ultimaFila - primeraFila + 1
|
||
DoEvents
|
||
End If
|
||
Next i
|
||
|
||
' Cerrar el formulario de progreso
|
||
Unload progressForm
|
||
|
||
' Restaurar configuraciones
|
||
Application.ScreenUpdating = True
|
||
Application.Calculation = xlCalculationAutomatic
|
||
Application.EnableEvents = True
|
||
|
||
MsgBox Replace(GetTranslatedMessage("ROWS_HIDDEN"), "{0}", CStr(ultimaFila - primeraFila + 1)), vbInformation
|
||
End Sub
|
||
|
||
Sub MostrarTodasLasFilas()
|
||
|
||
Set ws = ActiveSheet
|
||
|
||
' Mostrar todas las filas antes de comenzar la importaci<63>n
|
||
ws.Rows.Hidden = False
|
||
|
||
End Sub
|
||
|
||
Sub Exportar_A_SIPA()
|
||
Dim ws As Worksheet
|
||
Dim wsSIPA As Worksheet
|
||
Dim primeraFila As Integer, primeraColumna As Integer
|
||
Dim rowIndex As Variant
|
||
Dim cellValue As Variant
|
||
Dim lastRow As Long
|
||
Dim numAlarmas As Integer
|
||
Dim visibleRows As New Collection
|
||
Dim uniqueValues As Object
|
||
Dim duplicateFound As Boolean
|
||
Dim duplicateValue As Variant
|
||
Dim duplicateRow As Long
|
||
Dim wsDict As Object
|
||
Dim wsSIPADict As Object
|
||
Dim key As Variant
|
||
Dim sipaRow As Long
|
||
Dim db As Long, xbyte As Long, bit As Long
|
||
Dim lastSipaRow As Long
|
||
|
||
sipaRow = 2
|
||
primeraFila = 5
|
||
primeraColumna = 2
|
||
Set ws = ActiveSheet
|
||
|
||
|
||
' Verificar si la hoja "Per Supervisore SIPA" existe
|
||
On Error Resume Next
|
||
Set wsSIPA = ThisWorkbook.Worksheets("Per Supervisore SIPA")
|
||
On Error GoTo 0
|
||
|
||
If wsSIPA Is Nothing Then
|
||
MsgBox GetTranslatedMessage("SIPA_SHEET_NOT_FOUND"), vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
Set uniqueValues = CreateObject("Scripting.Dictionary")
|
||
|
||
' Crear y llenar el diccionario para ws
|
||
Set wsDict = 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)
|
||
|
||
' Crear y llenar el diccionario para wsSIPA
|
||
Set wsSIPADict = CreateDict("Alarm-Warning", 0, "Number", 1, "Tag", 2, "Sections", 3, _
|
||
"Priority", 4, "Description", 5, "Used", 6)
|
||
|
||
' Verificar valores <20>nicos en la columna primeraColumna
|
||
lastRow = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||
duplicateFound = False
|
||
|
||
For rowIndex = primeraFila + 1 To lastRow
|
||
If Not ws.Rows(rowIndex).Hidden Then
|
||
cellValue = ws.Cells(rowIndex, primeraColumna).value
|
||
|
||
If Not IsEmpty(cellValue) Then
|
||
If uniqueValues.Exists(CStr(cellValue)) Then
|
||
duplicateFound = True
|
||
duplicateValue = cellValue
|
||
duplicateRow = rowIndex
|
||
Exit For
|
||
Else
|
||
uniqueValues.Add CStr(cellValue), rowIndex
|
||
End If
|
||
End If
|
||
End If
|
||
Next rowIndex
|
||
|
||
If duplicateFound Then
|
||
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", duplicateValue), "{1}", duplicateRow), vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
' Calcular el n<>mero de alarmas considerando solo las filas visibles
|
||
numAlarmas = 0
|
||
For rowIndex = primeraFila + 1 To lastRow
|
||
If Not ws.Rows(rowIndex).Hidden Then
|
||
numAlarmas = numAlarmas + 1
|
||
visibleRows.Add rowIndex
|
||
End If
|
||
Next rowIndex
|
||
|
||
' Eliminar filas existentes en wsSIPA desde sipaRow
|
||
lastSipaRow = wsSIPA.Cells(wsSIPA.Rows.Count, 1).End(xlUp).row
|
||
If lastSipaRow >= sipaRow Then
|
||
wsSIPA.Rows(sipaRow & ":" & lastSipaRow).Delete
|
||
End If
|
||
|
||
For Each rowIndex In visibleRows
|
||
For Each key In wsSIPADict.Keys
|
||
Select Case key
|
||
Case "Alarm-Warning"
|
||
If UCase(ws.Cells(rowIndex, wsDict("Is Warning") + primeraColumna).value) = "X" Then
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = "Warning"
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).Font.Color = RGB(0, 32, 240) ' Celeste
|
||
Else
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = "Alarm"
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).Font.Color = RGB(255, 0, 0) ' Rojo
|
||
End If
|
||
|
||
Case "Number"
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = ws.Cells(rowIndex, wsDict("AlarmNum") + primeraColumna).value
|
||
|
||
Case "Tag"
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = "DB" & ws.Cells(rowIndex, wsDict("DB") + primeraColumna).value & _
|
||
".DBX" & ws.Cells(rowIndex, wsDict("Byte") + primeraColumna).value & _
|
||
"." & ws.Cells(rowIndex, wsDict("Bit") + primeraColumna).value
|
||
|
||
Case "Sections"
|
||
Dim sectionList As String
|
||
Dim sectionNum As Integer
|
||
sectionList = ""
|
||
|
||
For sectionNum = 1 To 5
|
||
If UCase(ws.Cells(rowIndex, wsDict("Section." & sectionNum) + primeraColumna).value) = "X" Then
|
||
If sectionList <> "" Then
|
||
sectionList = sectionList & ","
|
||
End If
|
||
sectionList = sectionList & sectionNum
|
||
End If
|
||
Next sectionNum
|
||
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = sectionList
|
||
|
||
Case "Priority"
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = ws.Cells(rowIndex, wsDict("Priority") + primeraColumna).value
|
||
|
||
Case "Description"
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = ws.Cells(rowIndex, wsDict("Descripci<63>n") + primeraColumna).value
|
||
|
||
Case "Used"
|
||
If UCase(ws.Cells(rowIndex, wsDict("Disable") + primeraColumna).value) <> "X" Then
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = ChrW(9679)
|
||
Else
|
||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = "-"
|
||
End If
|
||
End Select
|
||
Next key
|
||
sipaRow = sipaRow + 1
|
||
Next rowIndex
|
||
|
||
|
||
' Pedir al usuario un nombre de archivo para guardar
|
||
Dim newFilePath As String
|
||
newFilePath = Application.GetSaveAsFilename(InitialFileName:="Mappa Allarmi Completa Supervisore", _
|
||
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
|
||
Title:="Guardar hoja SIPA como")
|
||
|
||
' Verificar si el usuario cancel<65> la operaci<63>n
|
||
If newFilePath <> "False" Then
|
||
' Crear un nuevo libro de Excel
|
||
Dim newWorkbook As Workbook
|
||
Set newWorkbook = Application.Workbooks.Add
|
||
|
||
' Copiar la hoja wsSIPA al nuevo libro
|
||
wsSIPA.Copy Before:=newWorkbook.Sheets(1)
|
||
|
||
' Eliminar la hoja en blanco que se crea por defecto
|
||
Application.DisplayAlerts = False
|
||
newWorkbook.Sheets(2).Delete
|
||
Application.DisplayAlerts = True
|
||
|
||
' Guardar el nuevo libro
|
||
newWorkbook.SaveAs Filename:=newFilePath
|
||
newWorkbook.Close SaveChanges:=True
|
||
|
||
MsgBox Replace(GetTranslatedMessage("SIPA_EXPORT_SAVED"), "{0}", newFilePath), vbInformation
|
||
Else
|
||
MsgBox GetTranslatedMessage("SIPA_EXPORT_NOT_SAVED"), vbInformation
|
||
End If
|
||
|
||
' Activar la hoja wsSIPA
|
||
'wsSIPA.Activate
|
||
|
||
MsgBox GetTranslatedMessage("SIPA_EXPORT_COMPLETE"), vbInformation
|
||
End Sub
|
||
|
||
Function GetDictValue(dict As Object, key As Variant) As Variant
|
||
If VarType(key) = vbString Then
|
||
' Si la clave es una cadena, acceder directamente
|
||
GetDictValue = dict(key)
|
||
ElseIf IsNumeric(key) Then
|
||
' Si la clave es un n<>mero, buscar la clave correspondiente
|
||
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 partes As Variant
|
||
partes = Split(texto, "/")
|
||
If UBound(partes) >= 0 Then
|
||
GetDB = CLng(partes(0))
|
||
Else
|
||
GetDB = -1 ' Retorna -1 si no se encuentra el DB
|
||
End If
|
||
End Function
|
||
|
||
Function GetByte(texto As String) As Long
|
||
Dim partes As Variant
|
||
partes = Split(texto, "/")
|
||
If UBound(partes) >= 1 Then
|
||
GetByte = CLng(partes(1))
|
||
Else
|
||
GetByte = -1 ' Retorna -1 si no se encuentra el Byte
|
||
End If
|
||
End Function
|
||
|
||
Function GetBit(texto As String) As Long
|
||
Dim partes As Variant
|
||
partes = Split(texto, "/")
|
||
If UBound(partes) >= 2 Then
|
||
' Extraer el n<>mero del bit (puede estar seguido por espacio y m<>s texto)
|
||
Dim bitPart As String
|
||
bitPart = Split(partes(2), " ")(0)
|
||
GetBit = CLng(bitPart)
|
||
Else
|
||
GetBit = -1 ' Retorna -1 si no se encuentra el Bit
|
||
End If
|
||
End Function
|
||
|
||
|
||
Function GetExcelLanguage() As String
|
||
Dim langID As Long
|
||
langID = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
|
||
|
||
Select Case langID
|
||
' Espa<70>ol (varias variantes)
|
||
Case 3082, 1034, 11274, 16394, 13322, 9226, 5130, 7178, 12298, 17418, 4106, 18442, 19466, 6154, 15370, 10250, 20490, 21514, 14346, 8202
|
||
GetExcelLanguage = "ES"
|
||
|
||
' Italiano
|
||
Case 1040, 2064
|
||
GetExcelLanguage = "IT"
|
||
|
||
' Ingl<67>s (varias variantes)
|
||
Case 1033, 2057, 3081, 4105, 5129, 6153, 7177, 8201, 9225, 10249, 11273, 12297, 13321, 14345, 15369, 16393, 17417, 18441, 19465, 20489
|
||
GetExcelLanguage = "EN"
|
||
|
||
' Franc<6E>s
|
||
Case 1036, 2060, 3084, 4108, 5132, 6156, 7180, 8204, 9228, 10252, 11276, 12300, 13324, 14348, 15372, 16396, 20484
|
||
GetExcelLanguage = "FR"
|
||
|
||
' Alem<65>n
|
||
Case 1031, 2055, 3079, 4103, 5127
|
||
GetExcelLanguage = "DE"
|
||
|
||
' Portugu<67>s
|
||
Case 2070, 1046
|
||
GetExcelLanguage = "PT"
|
||
|
||
' Otros idiomas pueden ser a<>adidos aqu<71>
|
||
|
||
Case Else
|
||
' Si no se reconoce el idioma, se usa ingl<67>s por defecto
|
||
GetExcelLanguage = "EN"
|
||
End Select
|
||
|
||
' Para depuraci<63>n: imprimir el c<>digo de idioma detectado
|
||
Debug.Print "Detected Language ID: " & langID & ", Mapped to: " & GetExcelLanguage
|
||
End Function
|
||
|
||
' Funci<63>n para obtener mensajes traducidos
|
||
Function GetTranslatedMessage(msgKey As String) As String
|
||
Dim messages As Object
|
||
Dim langDict As Object
|
||
|
||
Set messages = CreateObject("Scripting.Dictionary")
|
||
|
||
' Mensajes en ingl<67>s (por defecto)
|
||
Set langDict = CreateObject("Scripting.Dictionary")
|
||
langDict.Add "IMPORT_COMPLETE", "Import completed."
|
||
langDict.Add "EXPORT_COMPLETE", "Export completed."
|
||
langDict.Add "FILE_NOT_SELECTED", "No file was selected. Operation cancelled."
|
||
langDict.Add "DUPLICATE_VALUE", "A duplicate value was found: {0} in row {1}. The operation has been aborted."
|
||
langDict.Add "ALARM_NODE_NOT_FOUND", "The 'Alarms' node was not found in the XML file."
|
||
langDict.Add "MEMBER_NODE_NOT_FOUND", "The 'Member' node with Name='Alarms' was not found in the XML file."
|
||
langDict.Add "ROWS_HIDDEN", "Process completed. Rows hidden: {0}"
|
||
langDict.Add "ALL_ROWS_SHOWN", "All rows are now visible."
|
||
langDict.Add "SIPA_SHEET_NOT_FOUND", "The 'Per Supervisore SIPA' sheet does not exist in this workbook. Please create this sheet before continuing."
|
||
langDict.Add "SIPA_EXPORT_COMPLETE", "SIPA export completed."
|
||
langDict.Add "SIPA_EXPORT_SAVED", "SIPA export completed and saved in {0}"
|
||
langDict.Add "SIPA_EXPORT_NOT_SAVED", "SIPA export completed. Not saved in a separate file."
|
||
messages.Add "EN", langDict
|
||
|
||
' Mensajes en español
|
||
Set langDict = CreateObject("Scripting.Dictionary")
|
||
langDict.Add "IMPORT_COMPLETE", "Importación completada."
|
||
langDict.Add "EXPORT_COMPLETE", "Exportación completada."
|
||
langDict.Add "FILE_NOT_SELECTED", "No se seleccionó ningún archivo. Operación cancelada."
|
||
langDict.Add "DUPLICATE_VALUE", "Se encontró un valor duplicado: {0} en la fila {1}. La operación ha sido abortada."
|
||
langDict.Add "ALARM_NODE_NOT_FOUND", "No se encontró el nodo 'Alarms' en el archivo XML."
|
||
langDict.Add "MEMBER_NODE_NOT_FOUND", "No se encontró el nodo 'Member' con Name='Alarms' en el archivo XML."
|
||
langDict.Add "ROWS_HIDDEN", "Proceso completado. Filas ocultadas: {0}"
|
||
langDict.Add "ALL_ROWS_SHOWN", "Todas las filas son ahora visibles."
|
||
langDict.Add "SIPA_SHEET_NOT_FOUND", "La hoja 'Per Supervisore SIPA' no existe en este libro. Por favor, cree esta hoja antes de continuar."
|
||
langDict.Add "SIPA_EXPORT_COMPLETE", "Exportación a SIPA completada."
|
||
langDict.Add "SIPA_EXPORT_SAVED", "Exportación a SIPA completada y guardada en {0}"
|
||
langDict.Add "SIPA_EXPORT_NOT_SAVED", "Exportación a SIPA completada. No se ha guardado en un archivo separado."
|
||
messages.Add "ES", langDict
|
||
|
||
' Mensajes en italiano
|
||
Set langDict = CreateObject("Scripting.Dictionary")
|
||
langDict.Add "IMPORT_COMPLETE", "Importazione completata."
|
||
langDict.Add "EXPORT_COMPLETE", "Esportazione completata."
|
||
langDict.Add "FILE_NOT_SELECTED", "Nessun file selezionato. Operazione annullata."
|
||
langDict.Add "DUPLICATE_VALUE", "È stato trovato un valore duplicato: {0} nella riga {1}. L'operazione è stata interrotta."
|
||
langDict.Add "ALARM_NODE_NOT_FOUND", "Il nodo 'Alarms' non è stato trovato nel file XML."
|
||
langDict.Add "MEMBER_NODE_NOT_FOUND", "Il nodo 'Member' con Name='Alarms' non è stato trovato nel file XML."
|
||
langDict.Add "ROWS_HIDDEN", "Processo completato. Righe nascoste: {0}"
|
||
langDict.Add "ALL_ROWS_SHOWN", "Tutte le righe sono ora visibili."
|
||
langDict.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."
|
||
langDict.Add "SIPA_EXPORT_COMPLETE", "Esportazione SIPA completata."
|
||
langDict.Add "SIPA_EXPORT_SAVED", "Esportazione SIPA completata e salvata in {0}"
|
||
langDict.Add "SIPA_EXPORT_NOT_SAVED", "Esportazione SIPA completata. Non salvata in un file separato."
|
||
messages.Add "IT", langDict
|
||
|
||
Dim lang As String
|
||
lang = GetExcelLanguage()
|
||
|
||
If messages.Exists(lang) And messages(lang).Exists(msgKey) Then
|
||
GetTranslatedMessage = messages(lang)(msgKey)
|
||
ElseIf messages("EN").Exists(msgKey) Then
|
||
GetTranslatedMessage = messages("EN")(msgKey) ' Fallback to English
|
||
Else
|
||
GetTranslatedMessage = "Message not found: " & msgKey ' Fallback if message key doesn't exist
|
||
End If
|
||
End Function
|