Mejorada la funcion de importacion para usar como indice el AlarmNum.
This commit is contained in:
parent
f819f41016
commit
4ae4179b0f
362
Funciones.bas
362
Funciones.bas
|
@ -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.
Loading…
Reference in New Issue