Funcion GenerateSiemensXML

This commit is contained in:
Miguel 2024-09-24 16:07:31 +02:00
parent f1d2d6b123
commit f40a9ee331
2 changed files with 224 additions and 0 deletions

View File

@ -447,6 +447,230 @@ Sub ExportSiemensXML()
End Sub End Sub
Sub GenerateSiemensXML()
Dim xmlDoc As Object
Dim rootNode As Object
Dim documentNode As Object
Dim xmlDeclaration As Object
Dim alarmNode As Object
Dim alarmsSectionsNode As Object
Dim alarmsSectionNode As Object
Dim newMemberNode As Object
Dim subElementNode As Object
Dim startValueNode As Object
Dim commentNode As Object
Dim multiLanguageTextNode As Object
Dim attributeListNode As Object
Dim nameNode As Object
Dim i As Integer, j As Integer
Dim ws As Worksheet
Dim filePath As String
Dim primeraFila As Integer, primeraColumna As Integer
Dim numAlarmas As Integer
Dim colOffset As Integer
Dim memberName As String
Dim memberDataType As String
Dim colIndex As Integer
Dim rowIndex As Integer
Dim cellValue As String
Dim description As String
Dim decimalValue As Long
Dim hexValue As String
Dim maxSectionIndex As Integer
Dim sectionIndex As Integer
primeraFila = 5
primeraColumna = 2
' Pedir al usuario que seleccione la ubicación para guardar el archivo XML
filePath = Application.GetSaveAsFilename("NuevoArchivo.xml", "Archivos XML (*.xml), *.xml", , "Guardar archivo XML")
' Verificar si se seleccionó una ruta
If filePath = "False" Or filePath = "Falso" Then
Exit Sub
End If
Set ws = ThisWorkbook.Sheets(1)
' Crear el documento XML
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
xmlDoc.async = False
' Añadir la declaración XML
Set xmlDeclaration = xmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
xmlDoc.appendChild xmlDeclaration
' Crear el nodo raíz
Set rootNode = xmlDoc.createElement("Document")
xmlDoc.appendChild rootNode
' Añadir el nodo de información del documento (opcional)
Set documentNode = xmlDoc.createElement("DocumentInfo")
rootNode.appendChild documentNode
' Aquí puedes añadir más información al DocumentInfo si lo deseas
' Crear el nodo "SW.DT"
Set alarmNode = xmlDoc.createElement("SW.DT")
alarmNode.setAttribute "ID", "0"
rootNode.appendChild alarmNode
' Crear el nodo "AttributeList" dentro de "SW.DT"
Set attributeListNode = xmlDoc.createElement("AttributeList")
alarmNode.appendChild attributeListNode
' Añadir los atributos necesarios (Nombre, Comentario, etc.)
Set nameNode = xmlDoc.createElement("Name")
nameNode.Text = "AllarmsDB"
attributeListNode.appendChild nameNode
' Añadir más atributos según sea necesario
' Crear el nodo "Sections" dentro de "SW.DT"
Set sectionsNode = xmlDoc.createElement("Sections")
alarmNode.appendChild sectionsNode
' Crear la sección "Static"
Set sectionNode = xmlDoc.createElement("Section")
sectionNode.setAttribute "Name", "Static"
sectionsNode.appendChild sectionNode
' Crear el miembro "Allarms"
Set memberNode = xmlDoc.createElement("Member")
memberNode.setAttribute "Name", "Allarms"
memberNode.setAttribute "Datatype", "Array"
sectionNode.appendChild memberNode
' Crear los nodos necesarios dentro de "Allarms"
' Aquí asumiremos que tienes una estructura similar a la del XML original
' Crear "Sections" dentro de "Allarms"
Set alarmsSectionsNode = xmlDoc.createElement("Sections")
memberNode.appendChild alarmsSectionsNode
' Crear "Section" dentro de "Sections" de "Allarms"
Set alarmsSectionNode = xmlDoc.createElement("Section")
alarmsSectionNode.setAttribute "Name", "Member"
alarmsSectionsNode.appendChild alarmsSectionNode
' Ahora añadiremos los miembros (campos) de cada alarma
' Primero, obtenemos los nombres de los miembros desde las columnas en Excel
Dim columnNames As Collection
Set columnNames = New Collection
colOffset = primeraColumna
Do While ws.Cells(primeraFila, colOffset).value <> ""
columnNames.Add ws.Cells(primeraFila, colOffset).value
colOffset = colOffset + 1
Loop
' Determinar el número de alarmas (filas)
numAlarmas = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).Row - (primeraFila + 1) + 1
' Ahora, creamos los miembros dentro de "Allarms"
Dim membersCollection As Collection
Set membersCollection = New Collection
' Colección para almacenar los tipos de datos
Dim memberDataTypes As Collection
Set memberDataTypes = New Collection
For i = 1 To columnNames.Count
memberName = columnNames(i)
' Determinar el tipo de dato basado en el nombre de la columna o alguna otra lógica
' Aquí asumiremos que tienes una manera de determinar el tipo de dato
' Por simplicidad, asumiremos que todos son Bool excepto "Descripción" y "Section.X"
If Left(memberName, 8) = "Section." Then
memberDataType = "Bool"
ElseIf memberName = "Descripción" Then
memberDataType = "String"
Else
memberDataType = "Bool"
End If
' Crear el miembro
Set newMemberNode = xmlDoc.createElement("Member")
newMemberNode.setAttribute "Name", memberName
newMemberNode.setAttribute "Datatype", memberDataType
alarmsSectionNode.appendChild newMemberNode
' Añadir a las colecciones
membersCollection.Add newMemberNode
memberDataTypes.Add memberDataType
Next i
' Ahora, añadimos los subelementos (valores) para cada alarma
For j = 1 To numAlarmas
rowIndex = primeraFila + j
' Verificar si la fila está oculta
If Not ws.Rows(rowIndex).Hidden Then
For i = 1 To membersCollection.Count
memberName = columnNames(i)
Set newMemberNode = membersCollection(i)
memberDataType = memberDataTypes(i)
' Crear el subelemento
Set subElementNode = xmlDoc.createElement("Subelement")
subElementNode.setAttribute "Path", CStr(j - 1)
newMemberNode.appendChild subElementNode
' Leer el valor de la celda
colIndex = primeraColumna + i - 1
cellValue = ws.Cells(rowIndex, colIndex).value
' Crear el nodo "StartValue"
Set startValueNode = xmlDoc.createElement("StartValue")
' Manejar los diferentes tipos de datos
If Left(memberName, 8) = "Section." Or memberDataType = "Bool" Then
' Convertir "X" a "TRUE", otros a "FALSE"
If UCase(Trim(cellValue)) = "X" Then
startValueNode.Text = "TRUE"
Else
startValueNode.Text = "FALSE"
End If
ElseIf memberDataType = "Byte" Then
' Convertir decimal a "16#xx"
If IsNumeric(cellValue) Then
decimalValue = CLng(cellValue)
hexValue = Hex(decimalValue)
If Len(hexValue) < 2 Then
hexValue = "0" & hexValue
End If
startValueNode.Text = "16#" & hexValue
Else
startValueNode.Text = "16#00"
End If
Else
' Otros tipos de datos
startValueNode.Text = CStr(cellValue)
End If
subElementNode.appendChild startValueNode
' Si es el campo "Descripción", agregar el nodo de comentario
If memberName = "Descripción" Then
Set commentNode = xmlDoc.createElement("Comment")
Set multiLanguageTextNode = xmlDoc.createElement("MultiLanguageText")
multiLanguageTextNode.setAttribute "Lang", "it-IT" ' Ajusta el idioma según sea necesario
multiLanguageTextNode.Text = CStr(cellValue)
commentNode.appendChild multiLanguageTextNode
subElementNode.appendChild commentNode
End If
Next i
End If
Next j
' Guardar el archivo XML
xmlDoc.Save filePath
MsgBox "Archivo XML generado exitosamente."
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

Binary file not shown.