diff --git a/Funciones.bas b/Funciones.bas index d646304..8a201bf 100644 --- a/Funciones.bas +++ b/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 - - - diff --git a/ImportExportDB5100 v0.2.xlsm b/ImportExportDB5100 v0.2.xlsm index d9d15c9..1f1cc42 100644 Binary files a/ImportExportDB5100 v0.2.xlsm and b/ImportExportDB5100 v0.2.xlsm differ diff --git a/ImportExportDB5100 v0.3.xlsm b/ImportExportDB5100 v0.3.xlsm new file mode 100644 index 0000000..a0ea11b Binary files /dev/null and b/ImportExportDB5100 v0.3.xlsm differ diff --git a/Paste.bas b/Paste.bas new file mode 100644 index 0000000..e69de29