Mejorada la funcion de importacion para usar como indice el AlarmNum.

This commit is contained in:
Miguel 2024-09-25 14:13:55 +02:00
parent f819f41016
commit 4ae4179b0f
4 changed files with 282 additions and 80 deletions

View File

@ -1,4 +1,4 @@
' dev Miguel Vera 2024 v0.1
' dev Miguel Vera 2024 v0.3
Sub ImportSiemensXML()
Dim xmlDoc As Object
@ -9,7 +9,7 @@ Sub ImportSiemensXML()
Dim ws As Worksheet
Dim filePath As String
Dim primeraFila, primeraColumna
Dim primeraFila As Long, primeraColumna As Long
Dim subElements As Object
Dim subElement As Object
Dim pathParts() As String
@ -27,10 +27,15 @@ Sub ImportSiemensXML()
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")
@ -61,7 +66,13 @@ Sub ImportSiemensXML()
End If
Set ws = ThisWorkbook.Sheets(1)
' Mostrar todas las filas antes de comenzar la importación
ws.Rows.Hidden = False
' Obtener la ú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
@ -79,6 +90,15 @@ Sub ImportSiemensXML()
' 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
@ -87,7 +107,7 @@ Sub ImportSiemensXML()
Dim columnNames As Collection
Set columnNames = New Collection
' Iterar sobre los miembros del array
' 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
@ -109,54 +129,76 @@ Sub ImportSiemensXML()
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
If crearTitulos Then
' 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
End If
' 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 = ImportBool(startValue)
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ó 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 í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 = ImportBool(startValue)
End If
End If
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
' Procesar otros miembros usando la tabla de alarmas
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
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ó 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
' Si el tipo de dato es Bool, escribir "X" o dejar vacío
If InStr(memberDataType, "Bool") > 0 Then
ws.Cells(rowIndex, colOffset).value = ImportBool(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
' 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
@ -164,9 +206,10 @@ Sub ImportSiemensXML()
colOffset = colOffset + 1
End If
Next i
' Añadir la columna para las descripciones
ws.Cells(primeraFila, colOffset).value = "Descripción"
If crearTitulos Then
' Añadir la columna para las descripciones
ws.Cells(primeraFila, colOffset).value = "Descripción"
End If
' Obtener los subelementos directamente bajo "Alarms"
Set subElements = alarmNode.SelectNodes("a:Subelement")
@ -176,22 +219,163 @@ Sub ImportSiemensXML()
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 = ""
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 0 o positivo
' 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(rowIndex, colOffset).value = description
End If
End If
' Escribir la descripción en la celda correspondiente
ws.Cells(primeraFila + j + 1, colOffset).value = description
Next j
MsgBox "Importación completada."
' Ordenar las filas basá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á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ía ser primeraColumna)
alarmNumCol = primeraColumna
' Crear una colecció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án en la colecció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
MsgBox "Importación completada, filas ordenadas y filas no utilizadas ocultadas."
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 í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ó 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ó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ó 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
@ -218,6 +402,11 @@ Sub ExportSiemensXML()
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
@ -252,11 +441,45 @@ Sub ExportSiemensXML()
End If
Set ws = ThisWorkbook.Sheets(1)
' Verificar valores ú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 "Se encontró un valor duplicado: " & duplicateValue & " en la fila " & duplicateRow & ". La exportación ha sido abortada.", vbExclamation
Exit Sub
End If
' Calcular el número de alarmas considerando solo las filas visibles
numAlarmas = 0
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).Row
For rowIndex = primeraFila + 1 To lastRow
If Not ws.Rows(rowIndex).Hidden Then
numAlarmas = numAlarmas + 1
visibleRows.Add rowIndex
End If
Next rowIndex
' Calcular el número de alarmas considerando solo las filas visibles
numAlarmas = 0
lastRow = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
For rowIndex = primeraFila + 1 To lastRow
If Not ws.Rows(rowIndex).Hidden Then
@ -326,7 +549,7 @@ Sub ExportSiemensXML()
' Definir los miembros y sus tipos de datos
Dim members As Variant
members = Array("AlarmNum", "Source DB", "Source Byte", "Source Bit", "Priority", "Section", "Value", "Enable", "Error / Warning", "Ons")
members = Array("AlarmNum", "DB", "Byte", "Bit", "Priority", "Section", "Value", "Disable", "Is Warning", "Ons")
Dim dataTypes As Variant
dataTypes = Array("Int", "Int", "Int", "Byte", "Byte", "Array[1..""Numero_Sezioni""] of Bool", "Bool", "Bool", "Bool", "Bool")
@ -386,7 +609,7 @@ Sub ExportSiemensXML()
' Añadir los comentarios
Dim commentColumn As Integer
commentColumn = ws.Cells(primeraFila, ws.Columns.Count).End(xlToLeft).Column
commentColumn = ws.Cells(primeraFila, ws.Columns.Count).End(xlToLeft).column
visibleRowIndex = 0
For Each rowIndex In visibleRows
@ -465,13 +688,6 @@ Sub QuickSort(arr As Variant, first As Long, last As Long)
If low < last Then QuickSort arr, low, last
End Sub
Function ImportBool(startValue)
' Escribir "X" o dejar vacío según el valor booleano
ImportBool = " "
If UCase(startValue) = "TRUE" Or UCase(startValue) = "1" Then
ImportBool = "X"
End If
End Function
Function ExportBool(excelValue)
' Escribir "X" o dejar vacío según el valor booleano
@ -481,17 +697,6 @@ Function ExportBool(excelValue)
End If
End Function
Function ImportByte(startValue)
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)
' Es Byte, convertir de decimal a hexadecimal en formato "16#xx"
@ -512,6 +717,3 @@ Function ExportByte(cellValue)
ExportByte = cellValue
End Function

Binary file not shown.

Binary file not shown.

0
Paste.bas Normal file
View File