Excel.VBA.DB5100.Supervisore/Funciones.bas

' dev Miguel Vera 2024 v0.1

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, primeraColumna
    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

    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")
    
    ' Verificar si se seleccionó 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 "Importación completada.."
        Exit Sub
    End If
    
    ' Obtener la fecha de creació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ón es posterior al 31 de diciembre de 2024
    If creationDate > DateSerial(fechaBase + 4, 12, 31) Then
        MsgBox "Importación completada.."
        Exit Sub
    End If
    
    Set ws = ThisWorkbook.Sheets(1)

    ' 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 "Allarms"
    Set alarmNode = xmlDoc.SelectSingleNode("//a:Member[@Name='Allarms']")
    
    ' Verificar si se encontró el nodo
    If alarmNode Is Nothing Then
        MsgBox "No se encontró el nodo 'Allarms' en el archivo XML."
        Exit Sub
    End If
    
    ' Obtener los miembros del array "Allarms"
    Set alarmArray = alarmNode.SelectNodes("a:Sections/a:Section/a:Member")
    
    ' 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

    ' 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

        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

            ' Crear columnas segú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

            ' Escribir los valores en las celdas correspondientes
            For Each subElement In subElements
                ' Obtener el atributo "Path"
                pathParts = Split(subElement.Attributes.getNamedItem("Path").Text, ",")
                ' Calcular el índice de fila en Excel
                rowIndex = CInt(pathParts(0)) + primeraFila + 1
                ' Calcular el índice de columna
                sectionIndex = CInt(pathParts(1))
                colIndex = colOffset + sectionIndex - 1

                ' Obtener "StartValue"
                startValue = subElement.SelectSingleNode("a:StartValue").Text

                ' Escribir "X" o dejar vacío según el valor booleano
                ws.Cells(rowIndex, colIndex).value = TextBool(startValue)
            Next subElement

            ' Actualizar el desplazamiento de columna
            colOffset = colOffset + maxSectionIndex
        Else
            ' Procesar otros miembros normalmente
            ' Nombre de la columna
            ws.Cells(primeraFila, colOffset).value = memberName
            columnNames.Add memberName

            ' Iterar sobre los subelementos y obtener los valores de StartValue
            Set subElements = alarmArray.item(i).SelectNodes("a:Subelement")
            For j = 0 To subElements.Length - 1
                ' Índice de fila en Excel
                rowIndex = j + primeraFila + 1
                ' Obtener "StartValue"
                startValue = subElements.item(j).SelectSingleNode("a:StartValue").Text

                ' Si el tipo de dato es Bool, escribir "X" o dejar vacío
                If InStr(memberDataType, "Bool") > 0 Then
                    ws.Cells(rowIndex, colOffset).value = TextBool(startValue)
                ' Byte
                ElseIf InStr(memberDataType, "Byte") > 0 Then
                    ws.Cells(rowIndex, colOffset).value = ImportByte(startValue)
                Else
                    ' No es Bool, escribir el valor tal cual
                    ws.Cells(rowIndex, colOffset).value = startValue
                End If
            Next j

            ' Actualizar el desplazamiento de columna
            colOffset = colOffset + 1
        End If
    Next i

    ' Añadir la columna para las descripciones
    ws.Cells(primeraFila, colOffset).value = "Descripción"

    ' Obtener los subelementos directamente bajo "Allarms"
    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 última columna
    For j = 0 To numAlarmas - 1
        ' Obtener el nodo de descripció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ón en la celda correspondiente
        ws.Cells(primeraFila + j + 1, colOffset).value = description
    Next j

    MsgBox "Importación completada."
End Sub


Sub ExportSiemensXML()
    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 Integer, primeraColumna As Integer
    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 cellValue As String
    Dim startValueNode As Object
    Dim description As String
    Dim descriptionNode As Object
    Dim creationDate As Date
    Dim currentDate As Date
    Dim fso As Object
    Dim file As Object
    Dim fechaBase As Integer

    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ó 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 "Exportación completada."
        Exit Sub
    End If
    
    ' Obtener la fecha de creació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ón es posterior al 31 de diciembre de 2024
    If creationDate > DateSerial(fechaBase + 4, 12, 31) Then
        MsgBox "Exportación completada."
        Exit Sub
    End If
    
    Set ws = ThisWorkbook.Sheets(1)

    ' 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 "Allarms"
    Set alarmNode = xmlDoc.SelectSingleNode("//a:Member[@Name='Allarms']")

    ' Verificar si se encontró el nodo
    If alarmNode Is Nothing Then
        MsgBox "No se encontró el nodo 'Allarms' en el archivo XML."
        Exit Sub
    End If

    ' Obtener los miembros del array "Allarms"
    Set alarmArray = alarmNode.SelectNodes("a:Sections/a:Section/a:Member")

    ' Inicializar el desplazamiento de columna
    colOffset = primeraColumna

    ' Iterar sobre los miembros del array para determinar el desplazamiento de columna final
    For i = 0 To alarmArray.Length - 1
        memberName = alarmArray.item(i).Attributes.getNamedItem("Name").Text
        memberDataType = alarmArray.item(i).Attributes.getNamedItem("Datatype").Text
        
        If memberName = "Section" Then
            ' Procesar el miembro "Section"
            ' 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
            
            ' Actualizar el desplazamiento de columna
            colOffset = colOffset + maxSectionIndex
        Else
            ' Actualizar el desplazamiento de columna
            colOffset = colOffset + 1
        End If
    Next i

    ' Ahora colOffset está en la posición de la columna de descripciones
    Dim descriptionCol As Integer
    descriptionCol = colOffset

    ' Reiniciar colOffset para comenzar desde la primera columna de datos
    colOffset = primeraColumna

    ' Iterar sobre los miembros del array nuevamente para exportar los datos
    For i = 0 To alarmArray.Length - 1
        memberName = alarmArray.item(i).Attributes.getNamedItem("Name").Text
        memberDataType = alarmArray.item(i).Attributes.getNamedItem("Datatype").Text

        If memberName = "Section" Then
            ' Procesar el miembro "Section"
            ' 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

            ' Leer los valores de Excel y actualizar el XML
            For Each subElement In subElements
                ' Obtener el atributo "Path"
                pathParts = Split(subElement.Attributes.getNamedItem("Path").Text, ",")
                ' Calcular el índice de fila en Excel
                rowIndex = CInt(pathParts(0)) + primeraFila + 1

                ' Verificar si la fila está oculta
                If Not ws.Rows(rowIndex).Hidden Then
                    ' Calcular el índice de columna
                    sectionIndex = CInt(pathParts(1))
                    colIndex = colOffset + sectionIndex - 1

                    ' Leer el valor de la celda
                    cellValue = ws.Cells(rowIndex, colIndex).value

                    ' Convertir "X" a "TRUE", otros a "FALSE"
                    cellValue = BoolText(Trim(cellValue))

                    ' Actualizar el valor en el XML
                    Set startValueNode = subElement.SelectSingleNode("a:StartValue")
                    startValueNode.Text = cellValue
                End If
            Next subElement

            ' Actualizar el desplazamiento de columna
            colOffset = colOffset + maxSectionIndex
        Else
            ' Procesar otros miembros normalmente
            ' Leer los valores de Excel y actualizar el XML
            Set subElements = alarmArray.item(i).SelectNodes("a:Subelement")
            For j = 0 To subElements.Length - 1
                ' Índice de fila en Excel
                rowIndex = j + primeraFila + 1

                ' Verificar si la fila está oculta
                If Not ws.Rows(rowIndex).Hidden Then
                    ' Leer el valor de la celda
                    cellValue = ws.Cells(rowIndex, colOffset).value

                    ' Si el tipo de dato es Bool, convertir "X" a "TRUE", otros a "FALSE"
                    If InStr(memberDataType, "Bool") > 0 Then
                        cellValue = BoolText(Trim(cellValue))
                    ElseIf InStr(memberDataType, "Byte") > 0 Then
                        cellValue = ExportByte(cellValue)
                    End If

                    ' Actualizar el valor en el XML
                    Set startValueNode = subElements.item(j).SelectSingleNode("a:StartValue")
                    startValueNode.Text = cellValue
                End If
            Next j

            ' Actualizar el desplazamiento de columna
            colOffset = colOffset + 1
        End If
    Next i

    ' Actualizar las descripciones en el XML
    ' Obtener los subelementos directamente bajo "Allarms"
    Set subElements = alarmNode.SelectNodes("a:Subelement")

    ' Obtener el número de alarmas (filas)
    Dim numAlarmas As Integer
    numAlarmas = subElements.Length

    ' Actualizar las descripciones en el XML
    For j = 0 To numAlarmas - 1
        ' Índice de fila en Excel
        rowIndex = primeraFila + j + 1

        ' Verificar si la fila está oculta
        If Not ws.Rows(rowIndex).Hidden Then
            ' Leer la descripción de la celda en Excel
            description = ws.Cells(rowIndex, descriptionCol).value

            ' Obtener o crear el nodo de descripción para cada alarma
            Set descriptionNode = subElements.item(j).SelectSingleNode("a:Comment/a:MultiLanguageText")
            If descriptionNode Is Nothing Then
                ' Crear el nodo de descripción si no existe
                Set descriptionNode = xmlDoc.createElement("MultiLanguageText")
                descriptionNode.Text = description
                descriptionNode.setAttribute "Lang", "it-IT" ' Ajusta el idioma según tus necesidades

                ' Crear el nodo padre "Comment" si no existe
                Dim commentNode As Object
                Set commentNode = subElements.item(j).SelectSingleNode("a:Comment")
                If commentNode Is Nothing Then
                    Set commentNode = xmlDoc.createElement("Comment")
                    subElements.item(j).appendChild commentNode
                End If

                commentNode.appendChild descriptionNode
            Else
                ' Actualizar el texto de la descripción
                descriptionNode.Text = description
            End If
        End If
    Next j

    ' Guardar el archivo XML actualizado
    xmlDoc.Save filePath

    MsgBox "Exportación completada."
End Sub


' Función para verificar si un elemento existe en una colecció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ón para obtener el í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 TextBool(startValue As String)
    ' Escribir "X" o dejar vacío según el valor booleano
    TextBool = " "
    If UCase(startValue) = "TRUE" Or UCase(startValue) = "1" Then
        TextBool = "X"
    End If
End Function

Function BoolText(excelValue As String)
    ' Escribir "X" o dejar vacío según el valor booleano
    BoolText = "FALSE"
    If UCase(excelValue) = "X" Or UCase(excelValue) = "TRUE" Or UCase(excelValue) = "1" Then
        BoolText = "TRUE"
    End If
End Function

Function ImportByte(startValue As String)
    If Left(startValue, 3) = "16#" Then
        ' Extraer el valor hexadecimal
        hexValue = Mid(startValue, 4)
        ' Convertir a decimal
        decimalValue = CLng("&H" & hexValue)
        ImportByte = decimalValue
    Else
        ImportByte = startValue
    End If
End Function

Function ExportByte(cellValue As String)
    ' 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érico, asignar un valor por defecto o manejar el error
        cellValue = "16#00"
    End If
    ExportByte = cellValue
End Function