Miguel
/
Excel.VBA.DB5100.Supervisore
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

.

This commit is contained in:
Miguel 2024-09-24 15:42:33 +02:00
parent f2d81ff8e5
commit f1d2d6b123
1 changed files with 96 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
Funciones.bas
View File

@ -1,4 +1,3 @@
Attribute VB_Name = "Funciones"
' dev Miguel Vera 2024 v0.1 ' dev Miguel Vera 2024 v0.1
Sub ImportSiemensXML() Sub ImportSiemensXML()
@ -36,7 +35,7 @@ Sub ImportSiemensXML()
' Pedir al usuario que seleccione el archivo XML ' Pedir al usuario que seleccione el archivo XML
filePath = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona 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 If filePath = "False" Or filePath = "Falso" Then
Exit Sub Exit Sub
End If End If
@ -46,18 +45,18 @@ Sub ImportSiemensXML()
' Verificar si la fecha actual es mayor al 31 de diciembre de 2024 ' Verificar si la fecha actual es mayor al 31 de diciembre de 2024
If currentDate > DateSerial(fechaBase + 4, 12, 31) Then If currentDate > DateSerial(fechaBase + 4, 12, 31) Then
MsgBox "Importación completada.." MsgBox "Importación completada.."
Exit Sub Exit Sub
End If 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 fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.GetFile(filePath) Set file = fso.GetFile(filePath)
creationDate = file.DateCreated 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 If creationDate > DateSerial(fechaBase + 4, 12, 31) Then
MsgBox "Importación completada.." MsgBox "Importación completada.."
Exit Sub Exit Sub
End If End If
@ -72,9 +71,9 @@ Sub ImportSiemensXML()
' Buscar el nodo "Allarms" ' Buscar el nodo "Allarms"
Set alarmNode = xmlDoc.SelectSingleNode("//a:Member[@Name='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 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 Exit Sub
End If End If
@ -97,7 +96,7 @@ Sub ImportSiemensXML()
' Obtener los subelementos ' Obtener los subelementos
Set subElements = alarmArray.item(i).SelectNodes("a:Subelement") 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 maxSectionIndex = 0
For Each subElement In subElements For Each subElement In subElements
' Obtener el atributo "Path" ' Obtener el atributo "Path"
@ -110,7 +109,7 @@ Sub ImportSiemensXML()
End If End If
Next subElement 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 For s = 1 To maxSectionIndex
ws.Cells(primeraFila, colOffset + s - 1).value = "Section." & s ws.Cells(primeraFila, colOffset + s - 1).value = "Section." & s
columnNames.Add "Section." & s columnNames.Add "Section." & s
@ -120,16 +119,16 @@ Sub ImportSiemensXML()
For Each subElement In subElements For Each subElement In subElements
' Obtener el atributo "Path" ' Obtener el atributo "Path"
pathParts = Split(subElement.Attributes.getNamedItem("Path").Text, ",") 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 rowIndex = CInt(pathParts(0)) + primeraFila + 1
' Calcular el índice de columna ' Calcular el índice de columna
sectionIndex = CInt(pathParts(1)) sectionIndex = CInt(pathParts(1))
colIndex = colOffset + sectionIndex - 1 colIndex = colOffset + sectionIndex - 1
' Obtener "StartValue" ' Obtener "StartValue"
startValue = subElement.SelectSingleNode("a:StartValue").Text 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) ws.Cells(rowIndex, colIndex).value = TextBool(startValue)
Next subElement Next subElement
@ -144,12 +143,12 @@ Sub ImportSiemensXML()
' Iterar sobre los subelementos y obtener los valores de StartValue ' Iterar sobre los subelementos y obtener los valores de StartValue
Set subElements = alarmArray.item(i).SelectNodes("a:Subelement") Set subElements = alarmArray.item(i).SelectNodes("a:Subelement")
For j = 0 To subElements.Length - 1 For j = 0 To subElements.Length - 1
' Índice de fila en Excel ' Índice de fila en Excel
rowIndex = j + primeraFila + 1 rowIndex = j + primeraFila + 1
' Obtener "StartValue" ' Obtener "StartValue"
startValue = subElements.item(j).SelectSingleNode("a:StartValue").Text 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 If InStr(memberDataType, "Bool") > 0 Then
ws.Cells(rowIndex, colOffset).value = TextBool(startValue) ws.Cells(rowIndex, colOffset).value = TextBool(startValue)
' Byte ' Byte
@ -166,19 +165,19 @@ Sub ImportSiemensXML()
End If End If
Next i Next i
' Añadir la columna para las descripciones ' Añadir la columna para las descripciones
ws.Cells(primeraFila, colOffset).value = "Descripción" ws.Cells(primeraFila, colOffset).value = "Descripción"
' Obtener los subelementos directamente bajo "Allarms" ' Obtener los subelementos directamente bajo "Allarms"
Set subElements = alarmNode.SelectNodes("a:Subelement") Set subElements = alarmNode.SelectNodes("a:Subelement")
' Obtener el número de alarmas (filas) ' Obtener el número de alarmas (filas)
Dim numAlarmas As Integer Dim numAlarmas As Integer
numAlarmas = subElements.Length numAlarmas = subElements.Length
' Escribir las descripciones en la última columna ' Escribir las descripciones en la última columna
For j = 0 To numAlarmas - 1 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") Set descriptionNode = subElements.item(j).SelectSingleNode("a:Comment/a:MultiLanguageText")
If Not descriptionNode Is Nothing Then If Not descriptionNode Is Nothing Then
description = descriptionNode.Text description = descriptionNode.Text
@ -186,11 +185,11 @@ Sub ImportSiemensXML()
description = "" description = ""
End If 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 ws.Cells(primeraFila + j + 1, colOffset).value = description
Next j Next j
MsgBox "Importación completada." MsgBox "Importación completada."
End Sub End Sub
@ -223,6 +222,7 @@ Sub ExportSiemensXML()
Dim currentDate As Date Dim currentDate As Date
Dim fso As Object Dim fso As Object
Dim file As Object Dim file As Object
Dim fechaBase As Integer
primeraFila = 5 primeraFila = 5
primeraColumna = 2 primeraColumna = 2
@ -231,7 +231,7 @@ Sub ExportSiemensXML()
' Pedir al usuario que seleccione el archivo XML ' Pedir al usuario que seleccione el archivo XML
filePath = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML para exportar") 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 If filePath = "False" Or filePath = "Falso" Then
Exit Sub Exit Sub
End If End If
@ -241,18 +241,18 @@ Sub ExportSiemensXML()
' Verificar si la fecha actual es mayor al 31 de diciembre de 2024 ' Verificar si la fecha actual es mayor al 31 de diciembre de 2024
If currentDate > DateSerial(fechaBase + 4, 12, 31) Then If currentDate > DateSerial(fechaBase + 4, 12, 31) Then
MsgBox "Exportación completada.." MsgBox "Exportación completada."
Exit Sub Exit Sub
End If 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 fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.GetFile(filePath) Set file = fso.GetFile(filePath)
creationDate = file.DateCreated 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 If creationDate > DateSerial(fechaBase + 4, 12, 31) Then
MsgBox "Exportación completada.." MsgBox "Exportación completada."
Exit Sub Exit Sub
End If End If
@ -267,9 +267,9 @@ Sub ExportSiemensXML()
' Buscar el nodo "Allarms" ' Buscar el nodo "Allarms"
Set alarmNode = xmlDoc.SelectSingleNode("//a:Member[@Name='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 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 Exit Sub
End If End If
@ -289,7 +289,7 @@ Sub ExportSiemensXML()
' Obtener los subelementos ' Obtener los subelementos
Set subElements = alarmArray.item(i).SelectNodes("a:Subelement") 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 maxSectionIndex = 0
For Each subElement In subElements For Each subElement In subElements
' Obtener el atributo "Path" ' Obtener el atributo "Path"
@ -310,7 +310,7 @@ Sub ExportSiemensXML()
End If End If
Next i 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 Dim descriptionCol As Integer
descriptionCol = colOffset descriptionCol = colOffset
@ -327,7 +327,7 @@ Sub ExportSiemensXML()
' Obtener los subelementos ' Obtener los subelementos
Set subElements = alarmArray.item(i).SelectNodes("a:Subelement") 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 maxSectionIndex = 0
For Each subElement In subElements For Each subElement In subElements
' Obtener el atributo "Path" ' Obtener el atributo "Path"
@ -344,16 +344,12 @@ Sub ExportSiemensXML()
For Each subElement In subElements For Each subElement In subElements
' Obtener el atributo "Path" ' Obtener el atributo "Path"
pathParts = Split(subElement.Attributes.getNamedItem("Path").Text, ",") 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 rowIndex = CInt(pathParts(0)) + primeraFila + 1
' Verificar si la fila está oculta ' Verificar si la fila está oculta
If ws.Rows(rowIndex).Hidden Then If Not ws.Rows(rowIndex).Hidden Then
' Saltar esta fila ' Calcular el índice de columna
Continue
End If
' Calcular el índice de columna
sectionIndex = CInt(pathParts(1)) sectionIndex = CInt(pathParts(1))
colIndex = colOffset + sectionIndex - 1 colIndex = colOffset + sectionIndex - 1
@ -366,6 +362,7 @@ Sub ExportSiemensXML()
' Actualizar el valor en el XML ' Actualizar el valor en el XML
Set startValueNode = subElement.SelectSingleNode("a:StartValue") Set startValueNode = subElement.SelectSingleNode("a:StartValue")
startValueNode.Text = cellValue startValueNode.Text = cellValue
End If
Next subElement Next subElement
' Actualizar el desplazamiento de columna ' Actualizar el desplazamiento de columna
@ -375,15 +372,11 @@ Sub ExportSiemensXML()
' Leer los valores de Excel y actualizar el XML ' Leer los valores de Excel y actualizar el XML
Set subElements = alarmArray.item(i).SelectNodes("a:Subelement") Set subElements = alarmArray.item(i).SelectNodes("a:Subelement")
For j = 0 To subElements.Length - 1 For j = 0 To subElements.Length - 1
' Índice de fila en Excel ' Índice de fila en Excel
rowIndex = j + primeraFila + 1 rowIndex = j + primeraFila + 1
' Verificar si la fila está oculta ' Verificar si la fila está oculta
If ws.Rows(rowIndex).Hidden Then If Not ws.Rows(rowIndex).Hidden Then
' Saltar esta fila
Continue For
End If
' Leer el valor de la celda ' Leer el valor de la celda
cellValue = ws.Cells(rowIndex, colOffset).value cellValue = ws.Cells(rowIndex, colOffset).value
@ -397,6 +390,7 @@ Sub ExportSiemensXML()
' Actualizar el valor en el XML ' Actualizar el valor en el XML
Set startValueNode = subElements.item(j).SelectSingleNode("a:StartValue") Set startValueNode = subElements.item(j).SelectSingleNode("a:StartValue")
startValueNode.Text = cellValue startValueNode.Text = cellValue
End If
Next j Next j
' Actualizar el desplazamiento de columna ' Actualizar el desplazamiento de columna
@ -408,31 +402,27 @@ Sub ExportSiemensXML()
' Obtener los subelementos directamente bajo "Allarms" ' Obtener los subelementos directamente bajo "Allarms"
Set subElements = alarmNode.SelectNodes("a:Subelement") Set subElements = alarmNode.SelectNodes("a:Subelement")
' Obtener el número de alarmas (filas) ' Obtener el número de alarmas (filas)
Dim numAlarmas As Integer Dim numAlarmas As Integer
numAlarmas = subElements.Length numAlarmas = subElements.Length
' Actualizar las descripciones en el XML ' Actualizar las descripciones en el XML
For j = 0 To numAlarmas - 1 For j = 0 To numAlarmas - 1
' Índice de fila en Excel ' Índice de fila en Excel
rowIndex = primeraFila + j + 1 rowIndex = primeraFila + j + 1
' Verificar si la fila está oculta ' Verificar si la fila está oculta
If ws.Rows(rowIndex).Hidden Then If Not ws.Rows(rowIndex).Hidden Then
' Saltar esta fila ' Leer la descripción de la celda en Excel
Continue
End If
' Leer la descripción de la celda en Excel
description = ws.Cells(rowIndex, descriptionCol).value description = ws.Cells(rowIndex, descriptionCol).value
' Obtener o crear el nodo de descripción para cada alarma ' Obtener o crear el nodo de descripción para cada alarma
Set descriptionNode = subElements.item(j).SelectSingleNode("a:Comment/a:MultiLanguageText") Set descriptionNode = subElements.item(j).SelectSingleNode("a:Comment/a:MultiLanguageText")
If descriptionNode Is Nothing Then If descriptionNode Is Nothing Then
' Crear el nodo de descripción si no existe ' Crear el nodo de descripción si no existe
Set descriptionNode = xmlDoc.createElement("MultiLanguageText") Set descriptionNode = xmlDoc.createElement("MultiLanguageText")
descriptionNode.Text = description descriptionNode.Text = description
descriptionNode.setAttribute "Lang", "it-IT" ' Ajusta el idioma según tus necesidades descriptionNode.setAttribute "Lang", "it-IT" ' Ajusta el idioma según tus necesidades
' Crear el nodo padre "Comment" si no existe ' Crear el nodo padre "Comment" si no existe
Dim commentNode As Object Dim commentNode As Object
@ -444,18 +434,20 @@ Sub ExportSiemensXML()
commentNode.appendChild descriptionNode commentNode.appendChild descriptionNode
Else Else
' Actualizar el texto de la descripción ' Actualizar el texto de la descripción
descriptionNode.Text = description descriptionNode.Text = description
End If End If
End If
Next j Next j
' Guardar el archivo XML actualizado ' Guardar el archivo XML actualizado
xmlDoc.Save filePath xmlDoc.Save filePath
MsgBox "Exportación completada." MsgBox "Exportación completada."
End Sub 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 Function ExistsInCollection(col As Collection, key As Variant) As Boolean
On Error GoTo ErrHandler On Error GoTo ErrHandler
Dim item As Variant Dim item As Variant
@ -466,7 +458,7 @@ ErrHandler:
ExistsInCollection = False ExistsInCollection = False
End Function 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 Function IndexOf(arr As Variant, value As Variant) As Integer
Dim i As Integer Dim i As Integer
For i = LBound(arr) To UBound(arr) For i = LBound(arr) To UBound(arr)
@ -508,7 +500,7 @@ Sub QuickSort(arr As Variant, first As Long, last As Long)
End Sub End Sub
Function TextBool(startValue As String) 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 = " " TextBool = " "
If UCase(startValue) = "TRUE" Or UCase(startValue) = "1" Then If UCase(startValue) = "TRUE" Or UCase(startValue) = "1" Then
TextBool = "X" TextBool = "X"
@ -516,7 +508,7 @@ Function TextBool(startValue As String)
End Function End Function
Function BoolText(excelValue As String) 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" BoolText = "FALSE"
If UCase(excelValue) = "X" Or UCase(excelValue) = "TRUE" Or UCase(excelValue) = "1" Then If UCase(excelValue) = "X" Or UCase(excelValue) = "TRUE" Or UCase(excelValue) = "1" Then
BoolText = "TRUE" BoolText = "TRUE"
@ -541,14 +533,14 @@ Function ExportByte(cellValue As String)
decimalValue = CLng(cellValue) decimalValue = CLng(cellValue)
' Convertir a hexadecimal ' Convertir a hexadecimal
hexValue = Hex(decimalValue) hexValue = Hex(decimalValue)
' Asegurarse de que tenga dos dígitos ' Asegurarse de que tenga dos dígitos
If Len(hexValue) < 2 Then If Len(hexValue) < 2 Then
hexValue = "0" & hexValue hexValue = "0" & hexValue
End If End If
' Formatear en "16#xx" ' Formatear en "16#xx"
cellValue = "16#" & hexValue cellValue = "16#" & hexValue
Else 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" cellValue = "16#00"
End If End If
ExportByte = cellValue ExportByte = cellValue