Excel.VBA.DB5100.Supervisore/Funciones v5.bas

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