From f1d2d6b1230fc53be8f0d197fd7e005547ac13ef Mon Sep 17 00:00:00 2001 From: Miguel Date: Tue, 24 Sep 2024 15:42:33 +0200 Subject: [PATCH] . --- Funciones.bas | 200 ++++++++++++++++++++++++-------------------------- 1 file changed, 96 insertions(+), 104 deletions(-) diff --git a/Funciones.bas b/Funciones.bas index 9247047..3b0c688 100644 --- a/Funciones.bas +++ b/Funciones.bas @@ -1,4 +1,3 @@ -Attribute VB_Name = "Funciones" ' dev Miguel Vera 2024 v0.1 Sub ImportSiemensXML() @@ -36,7 +35,7 @@ Sub ImportSiemensXML() ' 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 + ' Verificar si se seleccionó un archivo If filePath = "False" Or filePath = "Falso" Then Exit Sub End If @@ -46,18 +45,18 @@ Sub ImportSiemensXML() ' 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.." + MsgBox "Importación completada.." Exit Sub End If - ' Obtener la fecha de creación del archivo desde el sistema de archivos + ' 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 + ' 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.." + MsgBox "Importación completada.." Exit Sub End If @@ -72,9 +71,9 @@ Sub ImportSiemensXML() ' Buscar el nodo "Allarms" Set alarmNode = xmlDoc.SelectSingleNode("//a:Member[@Name='Allarms']") - ' Verificar si se encontró el nodo + ' Verificar si se encontró el nodo If alarmNode Is Nothing Then - MsgBox "No se encontró el nodo 'Allarms' en el archivo XML." + MsgBox "No se encontró el nodo 'Allarms' en el archivo XML." Exit Sub End If @@ -97,7 +96,7 @@ Sub ImportSiemensXML() ' Obtener los subelementos Set subElements = alarmArray.item(i).SelectNodes("a:Subelement") - ' Determinar el número máximo de secciones + ' Determinar el número máximo de secciones maxSectionIndex = 0 For Each subElement In subElements ' Obtener el atributo "Path" @@ -110,7 +109,7 @@ Sub ImportSiemensXML() End If Next subElement - ' Crear columnas según el número máximo de secciones + ' 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 @@ -120,16 +119,16 @@ Sub ImportSiemensXML() For Each subElement In subElements ' Obtener el atributo "Path" pathParts = Split(subElement.Attributes.getNamedItem("Path").Text, ",") - ' Calcular el índice de fila en Excel + ' Calcular el índice de fila en Excel rowIndex = CInt(pathParts(0)) + primeraFila + 1 - ' Calcular el índice de columna + ' 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 + ' Escribir "X" o dejar vacío según el valor booleano ws.Cells(rowIndex, colIndex).value = TextBool(startValue) Next subElement @@ -144,12 +143,12 @@ Sub ImportSiemensXML() ' 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 + ' Ã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 + ' 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 @@ -166,19 +165,19 @@ Sub ImportSiemensXML() End If Next i - ' Añadir la columna para las descripciones - ws.Cells(primeraFila, colOffset).value = "Descripción" + ' 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) + ' Obtener el número de alarmas (filas) Dim numAlarmas As Integer numAlarmas = subElements.Length - ' Escribir las descripciones en la última columna + ' Escribir las descripciones en la última columna For j = 0 To numAlarmas - 1 - ' Obtener el nodo de descripción para cada alarma + ' 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 @@ -186,11 +185,11 @@ Sub ImportSiemensXML() description = "" End If - ' Escribir la descripción en la celda correspondiente + ' Escribir la descripción en la celda correspondiente ws.Cells(primeraFila + j + 1, colOffset).value = description Next j - MsgBox "Importación completada." + MsgBox "Importación completada." End Sub @@ -223,6 +222,7 @@ Sub ExportSiemensXML() Dim currentDate As Date Dim fso As Object Dim file As Object + Dim fechaBase As Integer primeraFila = 5 primeraColumna = 2 @@ -231,7 +231,7 @@ Sub ExportSiemensXML() ' 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 + ' Verificar si se seleccionó un archivo If filePath = "False" Or filePath = "Falso" Then Exit Sub End If @@ -241,18 +241,18 @@ Sub ExportSiemensXML() ' 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.." + MsgBox "Exportación completada." Exit Sub End If - ' Obtener la fecha de creación del archivo desde el sistema de archivos + ' 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 + ' 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.." + MsgBox "Exportación completada." Exit Sub End If @@ -267,9 +267,9 @@ Sub ExportSiemensXML() ' Buscar el nodo "Allarms" Set alarmNode = xmlDoc.SelectSingleNode("//a:Member[@Name='Allarms']") - ' Verificar si se encontró el nodo + ' Verificar si se encontró el nodo If alarmNode Is Nothing Then - MsgBox "No se encontró el nodo 'Allarms' en el archivo XML." + MsgBox "No se encontró el nodo 'Allarms' en el archivo XML." Exit Sub End If @@ -289,7 +289,7 @@ Sub ExportSiemensXML() ' Obtener los subelementos Set subElements = alarmArray.item(i).SelectNodes("a:Subelement") - ' Determinar el número máximo de secciones + ' Determinar el número máximo de secciones maxSectionIndex = 0 For Each subElement In subElements ' Obtener el atributo "Path" @@ -310,7 +310,7 @@ Sub ExportSiemensXML() End If Next i - ' Ahora colOffset está en la posición de la columna de descripciones + ' Ahora colOffset está en la posición de la columna de descripciones Dim descriptionCol As Integer descriptionCol = colOffset @@ -327,7 +327,7 @@ Sub ExportSiemensXML() ' Obtener los subelementos Set subElements = alarmArray.item(i).SelectNodes("a:Subelement") - ' Determinar el número máximo de secciones + ' Determinar el número máximo de secciones maxSectionIndex = 0 For Each subElement In subElements ' Obtener el atributo "Path" @@ -344,28 +344,25 @@ Sub ExportSiemensXML() For Each subElement In subElements ' Obtener el atributo "Path" pathParts = Split(subElement.Attributes.getNamedItem("Path").Text, ",") - ' Calcular el índice de fila en Excel + ' Calcular el índice de fila en Excel rowIndex = CInt(pathParts(0)) + primeraFila + 1 - ' Verificar si la fila está oculta - If ws.Rows(rowIndex).Hidden Then - ' Saltar esta fila - Continue + ' 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 - - ' 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 Next subElement ' Actualizar el desplazamiento de columna @@ -375,28 +372,25 @@ Sub ExportSiemensXML() ' 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 + ' Ãndice de fila en Excel rowIndex = j + primeraFila + 1 - ' Verificar si la fila está oculta - If ws.Rows(rowIndex).Hidden Then - ' Saltar esta fila - Continue For + ' 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 - - ' 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 Next j ' Actualizar el desplazamiento de columna @@ -408,54 +402,52 @@ Sub ExportSiemensXML() ' Obtener los subelementos directamente bajo "Allarms" Set subElements = alarmNode.SelectNodes("a:Subelement") - ' Obtener el número de alarmas (filas) + ' 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 + ' Ãndice de fila en Excel rowIndex = primeraFila + j + 1 - ' Verificar si la fila está oculta - If ws.Rows(rowIndex).Hidden Then - ' Saltar esta fila - Continue - End If + ' 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 - ' 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 - ' 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 - ' 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 + commentNode.appendChild descriptionNode + Else + ' Actualizar el texto de la descripción + descriptionNode.Text = description End If - - commentNode.appendChild descriptionNode - Else - ' Actualizar el texto de la descripción - descriptionNode.Text = description End If Next j ' Guardar el archivo XML actualizado xmlDoc.Save filePath - MsgBox "Exportación completada." + MsgBox "Exportación completada." End Sub -' Función para verificar si un elemento existe en una colección + +' 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 @@ -466,7 +458,7 @@ ErrHandler: ExistsInCollection = False End Function -' Función para obtener el índice de un valor en un array +' 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) @@ -508,7 +500,7 @@ Sub QuickSort(arr As Variant, first As Long, last As Long) End Sub Function TextBool(startValue As String) - ' Escribir "X" o dejar vacío según el valor booleano + ' Escribir "X" o dejar vacío según el valor booleano TextBool = " " If UCase(startValue) = "TRUE" Or UCase(startValue) = "1" Then TextBool = "X" @@ -516,7 +508,7 @@ Function TextBool(startValue As String) End Function Function BoolText(excelValue As String) - ' Escribir "X" o dejar vacío según el valor booleano + ' 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" @@ -541,14 +533,14 @@ Function ExportByte(cellValue As String) decimalValue = CLng(cellValue) ' Convertir a hexadecimal hexValue = Hex(decimalValue) - ' Asegurarse de que tenga dos dígitos + ' 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 + ' Si no es numérico, asignar un valor por defecto o manejar el error cellValue = "16#00" End If ExportByte = cellValue