720 lines
27 KiB
QBasic
720 lines
27 KiB
QBasic
' dev Miguel Vera 2024 v0.3
|
|
|
|
Sub ImportSiemensXML()
|
|
Dim xmlDoc As Object
|
|
Dim xmlNode As Object
|
|
Dim alarmNode As Object
|
|
Dim alarmArray As Object
|
|
Dim i As Integer, j As Integer
|
|
Dim ws As Worksheet
|
|
Dim filePath As String
|
|
|
|
Dim primeraFila As Long, primeraColumna As Long
|
|
Dim subElements As Object
|
|
Dim subElement As Object
|
|
Dim pathParts() As String
|
|
Dim rowIndex As Integer
|
|
Dim colIndex As Integer
|
|
Dim memberName As String
|
|
Dim memberDataType As String
|
|
Dim colOffset As Integer
|
|
Dim s As Integer
|
|
Dim maxSectionIndex As Integer
|
|
Dim sectionIndex As Integer
|
|
Dim startValue As String
|
|
Dim description As String
|
|
Dim descriptionNode As Object
|
|
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")
|
|
|
|
' Verificar si se seleccionó un archivo
|
|
If filePath = "False" Or filePath = "Falso" Then
|
|
Exit Sub
|
|
End If
|
|
|
|
' Obtener la fecha actual
|
|
currentDate = Date
|
|
|
|
' 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.."
|
|
Exit Sub
|
|
End If
|
|
|
|
' 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
|
|
If creationDate > DateSerial(fechaBase + 4, 12, 31) Then
|
|
MsgBox "Importación completada.."
|
|
Exit Sub
|
|
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
|
|
xmlDoc.Load (filePath)
|
|
xmlDoc.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
|
|
|
' Buscar el nodo "Alarms"
|
|
Set alarmNode = xmlDoc.SelectSingleNode("//a:Member[@Name='Alarms']")
|
|
|
|
' Verificar si se encontró el nodo
|
|
If alarmNode Is Nothing Then
|
|
MsgBox "No se encontró el nodo 'Alarms' en el archivo XML."
|
|
Exit Sub
|
|
End If
|
|
|
|
' 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
|
|
|
|
' Crear una lista para almacenar los nombres de las columnas
|
|
Dim columnNames As Collection
|
|
Set columnNames = New Collection
|
|
|
|
' 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
|
|
|
|
If memberName = "Section" Then
|
|
' Obtener los subelementos
|
|
Set subElements = alarmArray.item(i).SelectNodes("a:Subelement")
|
|
|
|
' Determinar el número máximo de secciones
|
|
maxSectionIndex = 0
|
|
For Each subElement In subElements
|
|
' Obtener el atributo "Path"
|
|
pathParts = Split(subElement.Attributes.getNamedItem("Path").Text, ",")
|
|
If UBound(pathParts) >= 1 Then
|
|
sectionIndex = CInt(pathParts(1))
|
|
If sectionIndex > maxSectionIndex Then
|
|
maxSectionIndex = sectionIndex
|
|
End If
|
|
End If
|
|
Next subElement
|
|
|
|
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
|
|
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 usando la tabla de alarmas
|
|
Set subElements = alarmArray.item(i).SelectNodes("a:Subelement")
|
|
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 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
|
|
|
|
' 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
|
|
|
|
' Actualizar el desplazamiento de columna
|
|
colOffset = colOffset + 1
|
|
End If
|
|
Next i
|
|
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")
|
|
|
|
' Obtener el número de alarmas (filas)
|
|
Dim numAlarmas As Integer
|
|
numAlarmas = subElements.Length
|
|
|
|
' Escribir las descripciones en la última columna
|
|
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
|
|
Next j
|
|
|
|
' 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
|
|
Dim alarmsMemberNode As Object
|
|
Dim i As Long, j As Long
|
|
Dim ws As Worksheet
|
|
Dim filePath As String
|
|
|
|
Dim primeraFila As Integer, primeraColumna As Integer
|
|
Dim rowIndex As Variant
|
|
Dim colIndex As Integer
|
|
Dim memberName As String
|
|
Dim memberDataType As String
|
|
Dim cellValue As Variant
|
|
Dim startValueNode As Object
|
|
Dim creationDate As Date
|
|
Dim currentDate As Date
|
|
Dim fso As Object
|
|
Dim file As Object
|
|
Dim fechaBase As Integer
|
|
Dim numAlarmas As Integer
|
|
Dim sectionsNode As Object
|
|
Dim sectionNode As Object
|
|
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
|
|
fechaBase = 2020
|
|
|
|
' 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
|
|
If filePath = "False" Or filePath = "Falso" Then
|
|
Exit Sub
|
|
End If
|
|
|
|
' Obtener la fecha actual
|
|
currentDate = Date
|
|
|
|
' 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."
|
|
Exit Sub
|
|
End If
|
|
|
|
' 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
|
|
If creationDate > DateSerial(fechaBase + 4, 12, 31) Then
|
|
MsgBox "Exportación completada."
|
|
Exit Sub
|
|
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
|
|
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
|
|
numAlarmas = numAlarmas + 1
|
|
visibleRows.Add rowIndex
|
|
End If
|
|
Next rowIndex
|
|
|
|
' Cargar el archivo XML
|
|
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
|
|
xmlDoc.async = False
|
|
xmlDoc.Load (filePath)
|
|
xmlDoc.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
|
|
|
' Buscar el nodo "Member" con Name="Alarms"
|
|
Set alarmsMemberNode = xmlDoc.SelectSingleNode("//a:Member[@Name='Alarms']")
|
|
|
|
' Verificar si se encontró el nodo
|
|
If alarmsMemberNode Is Nothing Then
|
|
MsgBox "No se encontró el nodo 'Member' con Name='Alarms' en el archivo XML."
|
|
Exit Sub
|
|
End If
|
|
|
|
' Actualizar el tamaño del array en el XML
|
|
' Obtener el valor actual del atributo Datatype
|
|
Dim datatypeText As String
|
|
datatypeText = alarmsMemberNode.Attributes.getNamedItem("Datatype").Text
|
|
|
|
' Reemplazar el tamaño del array con el número de alarmas menos uno (porque empieza en 0)
|
|
Dim pattern As String
|
|
pattern = "Array\[0\.\.\d+\]"
|
|
Dim replacement As String
|
|
replacement = "Array[0.." & (numAlarmas - 1) & "]"
|
|
Dim regex As Object
|
|
Set regex = CreateObject("VBScript.RegExp")
|
|
regex.pattern = pattern
|
|
regex.Global = True
|
|
regex.IgnoreCase = False
|
|
|
|
datatypeText = regex.Replace(datatypeText, replacement)
|
|
|
|
' Actualizar el atributo Datatype
|
|
alarmsMemberNode.Attributes.getNamedItem("Datatype").Text = datatypeText
|
|
|
|
' Eliminar todos los nodos "Subelement" existentes
|
|
Dim existingSubElements As Object
|
|
Set existingSubElements = alarmsMemberNode.SelectNodes(".//a:Subelement")
|
|
For i = existingSubElements.Length - 1 To 0 Step -1
|
|
existingSubElements.item(i).ParentNode.RemoveChild existingSubElements.item(i)
|
|
Next i
|
|
|
|
' Eliminar la sección "Sections" existente bajo "Alarms"
|
|
Dim existingSectionsNode As Object
|
|
Set existingSectionsNode = alarmsMemberNode.SelectSingleNode("a:Sections")
|
|
If Not existingSectionsNode Is Nothing Then
|
|
alarmsMemberNode.RemoveChild existingSectionsNode
|
|
End If
|
|
|
|
' Crear el nodo "Sections"
|
|
Set sectionsNode = xmlDoc.createNode(1, "Sections", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|
alarmsMemberNode.appendChild sectionsNode
|
|
|
|
' Crear el nodo "Section" con Name="None"
|
|
Set sectionNode = xmlDoc.createNode(1, "Section", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|
sectionNode.Attributes.setNamedItem(xmlDoc.createAttribute("Name")).Text = "None"
|
|
sectionsNode.appendChild sectionNode
|
|
|
|
' Definir los miembros y sus tipos de datos
|
|
Dim members As Variant
|
|
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")
|
|
|
|
' Crear los miembros
|
|
For i = 0 To UBound(members)
|
|
Set memberNode = xmlDoc.createNode(1, "Member", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|
memberNode.Attributes.setNamedItem(xmlDoc.createAttribute("Name")).Text = members(i)
|
|
memberNode.Attributes.setNamedItem(xmlDoc.createAttribute("Datatype")).Text = dataTypes(i)
|
|
sectionNode.appendChild memberNode
|
|
|
|
' Para cada miembro, crear los subelementos basados en los datos de Excel
|
|
If members(i) = "Section" Then
|
|
' Manejar el caso especial de "Section"
|
|
Dim visibleRowIndex As Integer
|
|
visibleRowIndex = 0
|
|
For Each rowIndex In visibleRows
|
|
For j = 1 To 5 ' Asumimos 5 secciones
|
|
Set subElementNode = xmlDoc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|
subElementNode.Attributes.setNamedItem(xmlDoc.createAttribute("Path")).Text = visibleRowIndex & "," & j
|
|
|
|
Set startValueNode = xmlDoc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|
cellValue = ws.Cells(rowIndex, primeraColumna + i + j - 1).value
|
|
startValueNode.Text = IIf(UCase(Trim(cellValue)) = "X", "TRUE", "FALSE")
|
|
|
|
subElementNode.appendChild startValueNode
|
|
memberNode.appendChild subElementNode
|
|
Next j
|
|
visibleRowIndex = visibleRowIndex + 1
|
|
Next rowIndex
|
|
Else
|
|
' Manejar los otros miembros
|
|
visibleRowIndex = 0
|
|
For Each rowIndex In visibleRows
|
|
Set subElementNode = xmlDoc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|
subElementNode.Attributes.setNamedItem(xmlDoc.createAttribute("Path")).Text = CStr(visibleRowIndex)
|
|
|
|
Set startValueNode = xmlDoc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|
cellValue = ws.Cells(rowIndex, primeraColumna + i).value
|
|
|
|
Select Case dataTypes(i)
|
|
Case "Bool"
|
|
startValueNode.Text = IIf(UCase(Trim(cellValue)) = "X", "TRUE", "FALSE")
|
|
Case "Byte"
|
|
startValueNode.Text = ExportByte(cellValue)
|
|
Case "Int"
|
|
startValueNode.Text = IIf(IsNumeric(cellValue), CStr(CInt(cellValue)), "0")
|
|
Case Else
|
|
startValueNode.Text = CStr(cellValue)
|
|
End Select
|
|
|
|
subElementNode.appendChild startValueNode
|
|
memberNode.appendChild subElementNode
|
|
visibleRowIndex = visibleRowIndex + 1
|
|
Next rowIndex
|
|
End If
|
|
Next i
|
|
|
|
' Añadir los comentarios
|
|
Dim commentColumn As Integer
|
|
commentColumn = ws.Cells(primeraFila, ws.Columns.Count).End(xlToLeft).column
|
|
|
|
visibleRowIndex = 0
|
|
For Each rowIndex In visibleRows
|
|
Set subElementNode = xmlDoc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|
subElementNode.Attributes.setNamedItem(xmlDoc.createAttribute("Path")).Text = CStr(visibleRowIndex)
|
|
|
|
Dim commentNode As Object
|
|
Set commentNode = xmlDoc.createNode(1, "Comment", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|
|
|
Dim multiLangTextNode As Object
|
|
Set multiLangTextNode = xmlDoc.createNode(1, "MultiLanguageText", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
|
multiLangTextNode.Attributes.setNamedItem(xmlDoc.createAttribute("Lang")).Text = "it-IT"
|
|
multiLangTextNode.Text = ws.Cells(rowIndex, commentColumn).value
|
|
|
|
commentNode.appendChild multiLangTextNode
|
|
subElementNode.appendChild commentNode
|
|
alarmsMemberNode.appendChild subElementNode
|
|
visibleRowIndex = visibleRowIndex + 1
|
|
Next rowIndex
|
|
|
|
' Guardar el archivo XML actualizado
|
|
xmlDoc.Save filePath
|
|
|
|
MsgBox "Exportación completada. Exportadas " + Str(numAlarmas) + " Filas."
|
|
End Sub
|
|
|
|
' 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
|
|
item = col(key)
|
|
ExistsInCollection = True
|
|
Exit Function
|
|
ErrHandler:
|
|
ExistsInCollection = False
|
|
End Function
|
|
|
|
' 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)
|
|
If arr(i) = value Then
|
|
IndexOf = i - LBound(arr) + 1
|
|
Exit Function
|
|
End If
|
|
Next i
|
|
IndexOf = -1 ' No encontrado
|
|
End Function
|
|
|
|
' Procedimiento para ordenar un array de strings (QuickSort)
|
|
Sub QuickSort(arr As Variant, first As Long, last As Long)
|
|
Dim low As Long, high As Long
|
|
Dim pivot As Variant, temp As Variant
|
|
|
|
low = first
|
|
high = last
|
|
pivot = arr((first + last) \ 2)
|
|
|
|
Do While low <= high
|
|
Do While arr(low) < pivot
|
|
low = low + 1
|
|
Loop
|
|
Do While arr(high) > pivot
|
|
high = high - 1
|
|
Loop
|
|
If low <= high Then
|
|
temp = arr(low)
|
|
arr(low) = arr(high)
|
|
arr(high) = temp
|
|
low = low + 1
|
|
high = high - 1
|
|
End If
|
|
Loop
|
|
|
|
If first < high Then QuickSort arr, first, high
|
|
If low < last Then QuickSort arr, low, last
|
|
End Sub
|
|
|
|
|
|
Function ExportBool(excelValue)
|
|
' Escribir "X" o dejar vacío según el valor booleano
|
|
ExportBool = "FALSE"
|
|
If UCase(excelValue) = "X" Or UCase(excelValue) = "TRUE" Or UCase(excelValue) = "1" Then
|
|
ExportBool = "TRUE"
|
|
End If
|
|
End Function
|
|
|
|
|
|
Function ExportByte(cellValue)
|
|
' Es Byte, convertir de decimal a hexadecimal en formato "16#xx"
|
|
If IsNumeric(cellValue) Then
|
|
decimalValue = CLng(cellValue)
|
|
' Convertir a hexadecimal
|
|
hexValue = Hex(decimalValue)
|
|
' 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
|
|
cellValue = "16#00"
|
|
End If
|
|
ExportByte = cellValue
|
|
End Function
|
|
|