v5 Tested
This commit is contained in:
parent
23319b8e0b
commit
c73521505e
File diff suppressed because one or more lines are too long
|
|
@ -0,0 +1,816 @@
|
|||
Attribute VB_Name = "Funciones"
|
||||
' 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 = ActiveSheet
|
||||
|
||||
' 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
|
||||
|
||||
' Deshabilitar actualizaciones y cálculos
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
Application.EnableEvents = False
|
||||
|
||||
' Crear y mostrar el formulario de progreso
|
||||
Set progressForm = New progressForm
|
||||
progressForm.Show vbModeless
|
||||
|
||||
' 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
|
||||
|
||||
' Actualizar el progreso cada 10 filas (puedes ajustar este número)
|
||||
If i Mod 10 = 0 Then
|
||||
progressForm.UpdateProgress i - primeraFila + 1, ultimaFila - primeraFila + 1
|
||||
End If
|
||||
|
||||
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
|
||||
|
||||
' Cerrar el formulario de progreso
|
||||
Unload progressForm
|
||||
|
||||
' Restaurar configuraciones
|
||||
Application.ScreenUpdating = True
|
||||
Application.Calculation = xlCalculationAutomatic
|
||||
Application.EnableEvents = True
|
||||
|
||||
' 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 = ActiveSheet
|
||||
|
||||
' 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
|
||||
|
||||
' 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 memberCol As Variant
|
||||
memberCol = Array(0, 1, 2, 3, 4, 5, 10, 11, 12, 13)
|
||||
|
||||
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 + memberCol(i) + j - 1).value
|
||||
startValueNode.Text = ExportBool(Trim(cellValue))
|
||||
|
||||
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 + memberCol(i)).value
|
||||
|
||||
Select Case dataTypes(i)
|
||||
Case "Bool"
|
||||
startValueNode.Text = ExportBool(Trim(cellValue))
|
||||
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 = primeraColumna + 14
|
||||
|
||||
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
|
||||
|
||||
Sub MarcarFilasOcultas()
|
||||
Dim i As Long
|
||||
Dim columnaMarcar As Long
|
||||
Dim primeraColumna As Long
|
||||
Dim primeraFila As Long
|
||||
|
||||
primeraColumna = 2
|
||||
primeraFila = 5
|
||||
columnaMarcar = 17
|
||||
|
||||
Set ws = ActiveSheet
|
||||
' Verificar valores únicos en la columna primeraColumna
|
||||
ultimaFila = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||||
|
||||
For i = primeraFila To ultimaFila
|
||||
If ws.Rows(i).Hidden Then
|
||||
ws.Cells(i, columnaMarcar).value = "X"
|
||||
Else
|
||||
ws.Cells(i, columnaMarcar).value = ""
|
||||
End If
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
Sub OcultarFilasSegunMarca()
|
||||
Dim i As Long
|
||||
Dim columnaMarcar As Long
|
||||
Dim primeraColumna As Long
|
||||
Dim primeraFila As Long
|
||||
Dim ultimaFila As Long
|
||||
Dim ws As Worksheet
|
||||
Dim progressForm As progressForm
|
||||
|
||||
primeraColumna = 2
|
||||
primeraFila = 5
|
||||
columnaMarcar = 17
|
||||
|
||||
|
||||
' Deshabilitar actualizaciones y cálculos
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
Application.EnableEvents = False
|
||||
|
||||
Set ws = ActiveSheet
|
||||
' Mostrar todas las filas antes de comenzar la importación
|
||||
ws.Rows.Hidden = False
|
||||
' Verificar valores únicos en la columna primeraColumna
|
||||
ultimaFila = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||||
|
||||
' Crear y mostrar el formulario de progreso
|
||||
Set progressForm = New progressForm
|
||||
progressForm.Show vbModeless
|
||||
|
||||
For i = primeraFila To ultimaFila
|
||||
If UCase(ws.Cells(i, columnaMarcar).value) = "X" Then
|
||||
ws.Rows(i).Hidden = True
|
||||
End If
|
||||
|
||||
' Actualizar el progreso cada 10 filas (puedes ajustar este número)
|
||||
If i Mod 10 = 0 Then
|
||||
progressForm.UpdateProgress i - primeraFila + 1, ultimaFila - primeraFila + 1
|
||||
End If
|
||||
Next i
|
||||
|
||||
' Cerrar el formulario de progreso
|
||||
Unload progressForm
|
||||
|
||||
' Restaurar configuraciones
|
||||
Application.ScreenUpdating = True
|
||||
Application.Calculation = xlCalculationAutomatic
|
||||
Application.EnableEvents = True
|
||||
|
||||
MsgBox "Proceso completado", vbInformation
|
||||
End Sub
|
||||
|
||||
Sub MostrarTodasLasFilas()
|
||||
|
||||
Set ws = ActiveSheet
|
||||
|
||||
' Mostrar todas las filas antes de comenzar la importación
|
||||
ws.Rows.Hidden = False
|
||||
|
||||
End Sub
|
||||
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} progressForm
|
||||
Caption = "Working..."
|
||||
ClientHeight = 975
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 3525
|
||||
OleObjectBlob = "ProgressForm.frx":0000
|
||||
StartUpPosition = 1 'Centrar en propietario
|
||||
End
|
||||
Attribute VB_Name = "ProgressForm"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
' Código para ProgressForm
|
||||
Private Sub UserForm_Initialize()
|
||||
Me.StartUpPosition = 0
|
||||
Me.Left = Application.Left + (0.5 * Application.Width) - (0.5 * Me.Width)
|
||||
Me.Top = Application.Top + (0.5 * Application.Height) - (0.5 * Me.Height)
|
||||
End Sub
|
||||
|
||||
Public Sub UpdateProgress(current As Long, total As Long)
|
||||
lblProgress.Caption = "Procesando fila " & current & " de " & total
|
||||
' Si estás usando una ProgressBar real, descomenta la siguiente línea:
|
||||
' ProgressBar1.Value = (current / total) * 100
|
||||
DoEvents
|
||||
End Sub
|
||||
Binary file not shown.
|
|
@ -0,0 +1,72 @@
|
|||
|
||||
IF IS_ARRAY(#"DB Alarms") THEN
|
||||
// Calculate the maximum number of alarms (array size minus 1)
|
||||
#"Max Num of Alarms" := CountOfElements(#"DB Alarms") - 1;
|
||||
|
||||
// Initialize timing variables for performance monitoring
|
||||
#Aux."Elapsed Time s" := LREAL_TO_REAL(RUNTIME(#Aux.TimeRecorded));
|
||||
#Aux."Added Time" := 0.0;
|
||||
#Aux."alarms analysed for call" := 0;
|
||||
|
||||
// Main processing loop - continues until 0.5 seconds have elapsed
|
||||
WHILE #Aux."Added Time" < 0.5 DO
|
||||
// Reset index and clear section data when all alarms have been processed
|
||||
IF #Aux.index >= #"Max Num of Alarms" THEN
|
||||
#Aux.index := 0;
|
||||
// Reset section data for alarms and warnings
|
||||
FOR #s := 1 TO "Numero_Sezioni" DO
|
||||
IF NOT #"Sections Data"[#s]."Check Alarm" THEN
|
||||
#"Sections Data"[#s]."Actual Alarm" := 0;
|
||||
#"Sections Data"[#s]."Priority Alarm" := -1;
|
||||
END_IF;
|
||||
IF NOT #"Sections Data"[#s]."Check Warning" THEN
|
||||
#"Sections Data"[#s]."Actual Warning" := 0;
|
||||
#"Sections Data"[#s]."Priority Warning" := -1;
|
||||
END_IF;
|
||||
#"Sections Data"[#s]."Check Alarm" := FALSE;
|
||||
#"Sections Data"[#s]."Check Warning" := FALSE;
|
||||
END_FOR;
|
||||
END_IF;
|
||||
|
||||
// Move current alarm data to a temporary variable for processing
|
||||
#Result := MOVE_BLK_VARIANT(SRC := #"DB Alarms", COUNT := 1, SRC_INDEX := #Aux.index, DEST_INDEX := 0, DEST => #Alarm);
|
||||
|
||||
// Process the alarm if it's valid and enabled
|
||||
IF #Alarm.DB > 0 AND NOT #Alarm.Disable THEN
|
||||
// Store the previous state and read the current state
|
||||
#Alarm.Ons := #Alarm.Value;
|
||||
#Alarm.Value := PEEK_BOOL(area := #DB, dbNumber := #Alarm.DB, byteOffset := #Alarm."Byte", bitOffset := #Alarm.Bit);
|
||||
|
||||
// Check each section for this alarm
|
||||
FOR #s := 1 TO "Numero_Sezioni" DO
|
||||
IF #Alarm.Section[#s] THEN
|
||||
IF #Alarm.Value THEN
|
||||
// Process warnings
|
||||
IF #Alarm."Is Warning" AND (#"Sections Data"[#s]."Priority Warning" < #Alarm.Priority OR #Alarm.AlarmNum = #"Sections Data"[#s]."Actual Warning") THEN
|
||||
#"Sections Data"[#s]."Actual Warning" := #Alarm.AlarmNum;
|
||||
#"Sections Data"[#s]."Priority Warning" := #Alarm.Priority;
|
||||
#"Sections Data"[#s]."Check Warning" := TRUE;
|
||||
END_IF;
|
||||
// Process alarms
|
||||
IF NOT #Alarm."Is Warning" AND (#"Sections Data"[#s]."Priority Alarm" < #Alarm.Priority OR #Alarm.AlarmNum = #"Sections Data"[#s]."Actual Alarm") THEN
|
||||
#"Sections Data"[#s]."Actual Alarm" := #Alarm.AlarmNum;
|
||||
#"Sections Data"[#s]."Priority Alarm" := #Alarm.Priority;
|
||||
#"Sections Data"[#s]."Check Alarm" := TRUE;
|
||||
END_IF;
|
||||
END_IF;
|
||||
END_IF;
|
||||
END_FOR;
|
||||
END_IF;
|
||||
|
||||
// Write back the processed alarm data
|
||||
#Result := MOVE_BLK_VARIANT(SRC := #Alarm, COUNT := 1, SRC_INDEX := 0, DEST_INDEX := #Aux.index, DEST => #"DB Alarms");
|
||||
|
||||
// Update counters and timing information
|
||||
#Aux.index := #Aux.index + 1;
|
||||
#Aux."alarms analysed for call" := #Aux."alarms analysed for call" + 1;
|
||||
#Aux."Elapsed Time s" := LREAL_TO_REAL(RUNTIME(#Aux.TimeRecorded));
|
||||
#Aux."Added Time" := #Aux."Added Time" + #Aux."Elapsed Time s" * 1000.0;
|
||||
|
||||
END_WHILE;
|
||||
|
||||
END_IF;
|
||||
File diff suppressed because it is too large
Load Diff
515
Funciones.bas
515
Funciones.bas
|
|
@ -1,3 +1,4 @@
|
|||
Attribute VB_Name = "Funciones"
|
||||
' dev Miguel Vera 2024 v0.3
|
||||
|
||||
Sub ImportSiemensXML()
|
||||
|
|
@ -40,37 +41,38 @@ Sub ImportSiemensXML()
|
|||
' 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
|
||||
' 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.."
|
||||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Obtener la fecha de creación del archivo desde el sistema de archivos
|
||||
' 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
|
||||
' 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.."
|
||||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Set ws = ThisWorkbook.Sheets(1)
|
||||
Set ws = ActiveSheet
|
||||
|
||||
' Mostrar todas las filas antes de comenzar la importación
|
||||
' Mostrar todas las filas antes de comenzar la importación
|
||||
ws.Rows.Hidden = False
|
||||
|
||||
' Obtener la última fila con datos en la hoja
|
||||
' Obtener la última fila con datos en la hoja
|
||||
lastRow = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||||
|
||||
' Cargar el archivo XML
|
||||
|
|
@ -82,9 +84,9 @@ Sub ImportSiemensXML()
|
|||
' Buscar el nodo "Alarms"
|
||||
Set alarmNode = xmlDoc.SelectSingleNode("//a:Member[@Name='Alarms']")
|
||||
|
||||
' Verificar si se encontró el nodo
|
||||
' Verificar si se encontró el nodo
|
||||
If alarmNode Is Nothing Then
|
||||
MsgBox "No se encontró el nodo 'Alarms' en el archivo XML."
|
||||
MsgBox GetTranslatedMessage("ALARM_NODE_NOT_FOUND"), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
|
@ -107,16 +109,31 @@ Sub ImportSiemensXML()
|
|||
Dim columnNames As Collection
|
||||
Set columnNames = New Collection
|
||||
|
||||
' Iterar sobre los miembros del array
|
||||
' Deshabilitar actualizaciones y cálculos
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
Application.EnableEvents = False
|
||||
|
||||
' Crear y mostrar el formulario de progreso
|
||||
Set progressForm = New progressForm
|
||||
progressForm.Show vbModeless
|
||||
|
||||
' 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
|
||||
|
||||
' Actualizar el progreso cada 10 filas (puedes ajustar este número)
|
||||
If i Mod 10 = 0 Then
|
||||
progressForm.UpdateProgress CInt(i), alarmArray.Length
|
||||
DoEvents
|
||||
End If
|
||||
|
||||
If memberName = "Section" Then
|
||||
' Obtener los subelementos
|
||||
Set subElements = alarmArray.item(i).SelectNodes("a:Subelement")
|
||||
|
||||
' Determinar el número máximo de secciones
|
||||
' Determinar el número máximo de secciones
|
||||
maxSectionIndex = 0
|
||||
For Each subElement In subElements
|
||||
' Obtener el atributo "Path"
|
||||
|
|
@ -130,7 +147,7 @@ Sub ImportSiemensXML()
|
|||
Next subElement
|
||||
|
||||
If crearTitulos Then
|
||||
' Crear columnas según el número máximo de secciones
|
||||
' 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
|
||||
|
|
@ -145,23 +162,23 @@ Sub ImportSiemensXML()
|
|||
' 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 ' Sólo procesar si rowIndex es positivo
|
||||
If rowIndex = 0 Then
|
||||
' Si no se encontró en la hoja, agregar una nueva fila al final
|
||||
' 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
|
||||
' 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
|
||||
' Escribir "X" o dejar vacío según el valor booleano
|
||||
ws.Cells(rowIndex, colIndex).value = ImportBool(startValue)
|
||||
End If
|
||||
End If
|
||||
|
|
@ -178,9 +195,9 @@ Sub ImportSiemensXML()
|
|||
' 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 ' Sólo procesar si rowIndex es positivo
|
||||
If rowIndex = 0 Then
|
||||
' Si no se encontró en la hoja, agregar una nueva fila al final
|
||||
' 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")
|
||||
|
|
@ -207,26 +224,32 @@ Sub ImportSiemensXML()
|
|||
End If
|
||||
Next i
|
||||
If crearTitulos Then
|
||||
' Añadir la columna para las descripciones
|
||||
ws.Cells(primeraFila, colOffset).value = "Descripción"
|
||||
' 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)
|
||||
' Obtener el número de alarmas (filas)
|
||||
Dim numAlarmas As Integer
|
||||
numAlarmas = subElements.Length
|
||||
|
||||
' Escribir las descripciones en la última columna
|
||||
' Escribir las descripciones en la última columna
|
||||
For j = 0 To subElements.Length - 1
|
||||
path = subElements.item(j).Attributes.getNamedItem("Path").Text
|
||||
|
||||
' Actualizar el progreso cada 10 filas (puedes ajustar este número)
|
||||
If i Mod 10 = 0 Then
|
||||
progressForm.UpdateProgress CInt(j), subElements.Length - 1
|
||||
DoEvents
|
||||
End If
|
||||
|
||||
' 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
|
||||
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
|
||||
|
|
@ -234,27 +257,27 @@ Sub ImportSiemensXML()
|
|||
description = ""
|
||||
End If
|
||||
|
||||
' Escribir la descripción en la celda correspondiente
|
||||
' 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
|
||||
' 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
|
||||
' 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)
|
||||
' Encontrar la columna del AlarmNum (que debería ser primeraColumna)
|
||||
alarmNumCol = primeraColumna
|
||||
|
||||
' Crear una colección de filas visibles basada en alarmTable
|
||||
' 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
|
||||
|
|
@ -264,7 +287,7 @@ Sub ImportSiemensXML()
|
|||
End If
|
||||
Next key
|
||||
|
||||
' Ocultar filas que no están en la colección de filas visibles
|
||||
' 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
|
||||
|
|
@ -274,7 +297,15 @@ Sub ImportSiemensXML()
|
|||
On Error GoTo 0
|
||||
Next row
|
||||
|
||||
MsgBox "Importación completada, filas ordenadas y filas no utilizadas ocultadas."
|
||||
' Cerrar el formulario de progreso
|
||||
Unload progressForm
|
||||
|
||||
' Restaurar configuraciones
|
||||
Application.ScreenUpdating = True
|
||||
Application.Calculation = xlCalculationAutomatic
|
||||
Application.EnableEvents = True
|
||||
|
||||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||||
End Sub
|
||||
|
||||
Sub CreateAlarmTable(alarmNode As Object, alarmTable As Object, ws As Worksheet, primeraColumna As Long)
|
||||
|
|
@ -295,7 +326,7 @@ Sub CreateAlarmTable(alarmNode As Object, alarmTable As Object, ws As Worksheet,
|
|||
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
|
||||
' Asignar -1 si StartValue es 0, de lo contrario buscar el índice de fila
|
||||
If startValue = "0" Then
|
||||
searchRowIndex = -1
|
||||
Else
|
||||
|
|
@ -309,7 +340,7 @@ Sub CreateAlarmTable(alarmNode As Object, alarmTable As Object, ws As Worksheet,
|
|||
alarmTable(path).Add "searchRowIndex", searchRowIndex
|
||||
Next subElement
|
||||
Else
|
||||
MsgBox "No se encontró el nodo AlarmNum."
|
||||
MsgBox "No se encontró el nodo AlarmNum."
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
|
@ -330,7 +361,7 @@ Function FindRowIndex(ws As Worksheet, column As Long, value As String) As Long
|
|||
FindRowIndex = 0
|
||||
End Function
|
||||
|
||||
' Y añade esta función en tu módulo de VBA:
|
||||
' 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
|
||||
|
|
@ -361,7 +392,7 @@ Function FindRowByAlarmNum(ws As Worksheet, alarmNum As Integer, primeraFila As
|
|||
End If
|
||||
Next i
|
||||
|
||||
FindRowByAlarmNum = 0 ' No se encontró la fila
|
||||
FindRowByAlarmNum = 0 ' No se encontró la fila
|
||||
End Function
|
||||
|
||||
Function ImportBool(startValue As String) As String
|
||||
|
|
@ -415,7 +446,7 @@ Sub ExportSiemensXML()
|
|||
' 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
|
||||
' Verificar si se seleccionó un archivo
|
||||
If filePath = "False" Or filePath = "Falso" Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
|
@ -425,24 +456,24 @@ Sub ExportSiemensXML()
|
|||
|
||||
' 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."
|
||||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Obtener la fecha de creación del archivo desde el sistema de archivos
|
||||
' 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
|
||||
' 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."
|
||||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Set ws = ThisWorkbook.Sheets(1)
|
||||
Set ws = ActiveSheet
|
||||
|
||||
' Verificar valores únicos en la columna primeraColumna
|
||||
' Verificar valores únicos en la columna primeraColumna
|
||||
lastRow = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||||
duplicateFound = False
|
||||
|
||||
|
|
@ -464,11 +495,11 @@ Sub ExportSiemensXML()
|
|||
Next rowIndex
|
||||
|
||||
If duplicateFound Then
|
||||
MsgBox "Se encontró un valor duplicado: " & duplicateValue & " en la fila " & duplicateRow & ". La exportación ha sido abortada.", vbExclamation
|
||||
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", duplicateValue), "{1}", duplicateRow), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Calcular el número de alarmas considerando solo las filas visibles
|
||||
' 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
|
||||
|
|
@ -486,18 +517,18 @@ Sub ExportSiemensXML()
|
|||
' Buscar el nodo "Member" con Name="Alarms"
|
||||
Set alarmsMemberNode = xmlDoc.SelectSingleNode("//a:Member[@Name='Alarms']")
|
||||
|
||||
' Verificar si se encontró el nodo
|
||||
' 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."
|
||||
MsgBox GetTranslatedMessage("MEMBER_NODE_NOT_FOUND"), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Actualizar el tamaño del array en el XML
|
||||
' 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)
|
||||
' 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
|
||||
|
|
@ -520,7 +551,7 @@ Sub ExportSiemensXML()
|
|||
existingSubElements.item(i).ParentNode.RemoveChild existingSubElements.item(i)
|
||||
Next i
|
||||
|
||||
' Eliminar la sección "Sections" existente bajo "Alarms"
|
||||
' Eliminar la sección "Sections" existente bajo "Alarms"
|
||||
Dim existingSectionsNode As Object
|
||||
Set existingSectionsNode = alarmsMemberNode.SelectSingleNode("a:Sections")
|
||||
If Not existingSectionsNode Is Nothing Then
|
||||
|
|
@ -545,6 +576,10 @@ Sub ExportSiemensXML()
|
|||
Dim dataTypes As Variant
|
||||
dataTypes = Array("Int", "Int", "Int", "Byte", "Byte", "Array[1..""Numero_Sezioni""] of Bool", "Bool", "Bool", "Bool", "Bool")
|
||||
|
||||
' Crear y mostrar el formulario de progreso
|
||||
Set progressForm = New progressForm
|
||||
progressForm.Show vbModeless
|
||||
|
||||
' Crear los miembros
|
||||
For i = 0 To UBound(members)
|
||||
Set memberNode = xmlDoc.createNode(1, "Member", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
|
|
@ -552,13 +587,16 @@ Sub ExportSiemensXML()
|
|||
memberNode.Attributes.setNamedItem(xmlDoc.createAttribute("Datatype")).Text = dataTypes(i)
|
||||
sectionNode.appendChild memberNode
|
||||
|
||||
' Actualizar el progreso cada 10 filas (puedes ajustar este número)
|
||||
progressForm.UpdateProgress CInt(i), UBound(members)
|
||||
|
||||
' 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
|
||||
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
|
||||
|
||||
|
|
@ -582,14 +620,14 @@ Sub ExportSiemensXML()
|
|||
cellValue = ws.Cells(rowIndex, primeraColumna + memberCol(i)).value
|
||||
|
||||
Select Case dataTypes(i)
|
||||
Case "Bool"
|
||||
startValueNode.Text = ExportBool(Trim(cellValue))
|
||||
Case "Byte"
|
||||
startValueNode.Text = ExportByte(cellValue)
|
||||
Case "Int"
|
||||
startValueNode.Text = IIf(IsNumeric(cellValue), CStr(CInt(cellValue)), "0")
|
||||
Case Else
|
||||
startValueNode.Text = CStr(cellValue)
|
||||
Case "Bool"
|
||||
startValueNode.Text = ExportBool(Trim(cellValue))
|
||||
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
|
||||
|
|
@ -599,7 +637,7 @@ Sub ExportSiemensXML()
|
|||
End If
|
||||
Next i
|
||||
|
||||
' Añadir los comentarios
|
||||
' Añadir los comentarios
|
||||
Dim commentColumn As Integer
|
||||
commentColumn = primeraColumna + 14
|
||||
|
||||
|
|
@ -625,10 +663,13 @@ Sub ExportSiemensXML()
|
|||
' Guardar el archivo XML actualizado
|
||||
xmlDoc.Save filePath
|
||||
|
||||
MsgBox "Exportación completada. Exportadas " + Str(numAlarmas) + " Filas."
|
||||
' Cerrar el formulario de progreso
|
||||
Unload progressForm
|
||||
|
||||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||||
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
|
||||
On Error GoTo ErrHandler
|
||||
Dim item As Variant
|
||||
|
|
@ -639,7 +680,7 @@ ErrHandler:
|
|||
ExistsInCollection = False
|
||||
End Function
|
||||
|
||||
' Función para obtener el índice de un valor en un array
|
||||
' 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)
|
||||
|
|
@ -648,7 +689,7 @@ Function IndexOf(arr As Variant, value As Variant) As Integer
|
|||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
IndexOf = -1 ' No encontrado
|
||||
IndexOf = -1 ' No encontrado
|
||||
End Function
|
||||
|
||||
' Procedimiento para ordenar un array de strings (QuickSort)
|
||||
|
|
@ -680,30 +721,28 @@ Sub QuickSort(arr As Variant, first As Long, last As Long)
|
|||
If low < last Then QuickSort arr, low, last
|
||||
End Sub
|
||||
|
||||
|
||||
Function ExportBool(excelValue)
|
||||
' Escribir "X" o dejar vacío según el valor booleano
|
||||
' 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
|
||||
' 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
|
||||
' Si no es numérico, asignar un valor por defecto o manejar el error
|
||||
cellValue = "16#00"
|
||||
End If
|
||||
ExportByte = cellValue
|
||||
|
|
@ -716,11 +755,11 @@ Sub MarcarFilasOcultas()
|
|||
Dim primeraFila As Long
|
||||
|
||||
primeraColumna = 2
|
||||
primeraFila = 5
|
||||
primeraFila = 5 + 1
|
||||
columnaMarcar = 17
|
||||
|
||||
Set ws = ThisWorkbook.Sheets(1)
|
||||
' Verificar valores únicos en la columna primeraColumna
|
||||
Set ws = ActiveSheet
|
||||
' Verificar valores únicos en la columna primeraColumna
|
||||
ultimaFila = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||||
|
||||
For i = primeraFila To ultimaFila
|
||||
|
|
@ -746,15 +785,15 @@ Sub OcultarFilasSegunMarca()
|
|||
columnaMarcar = 17
|
||||
|
||||
|
||||
' Deshabilitar actualizaciones y cálculos
|
||||
' Deshabilitar actualizaciones y cálculos
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
Application.EnableEvents = False
|
||||
|
||||
Set ws = ThisWorkbook.Sheets(1)
|
||||
' Mostrar todas las filas antes de comenzar la importación
|
||||
Set ws = ActiveSheet
|
||||
' Mostrar todas las filas antes de comenzar la importación
|
||||
ws.Rows.Hidden = False
|
||||
' Verificar valores únicos en la columna primeraColumna
|
||||
' Verificar valores únicos en la columna primeraColumna
|
||||
ultimaFila = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
|
||||
|
||||
' Crear y mostrar el formulario de progreso
|
||||
|
|
@ -762,13 +801,14 @@ Sub OcultarFilasSegunMarca()
|
|||
progressForm.Show vbModeless
|
||||
|
||||
For i = primeraFila To ultimaFila
|
||||
If ws.Cells(i, columnaMarcar).value = "X" Then
|
||||
If UCase(ws.Cells(i, columnaMarcar).value) = "X" Then
|
||||
ws.Rows(i).Hidden = True
|
||||
End If
|
||||
|
||||
' Actualizar el progreso cada 10 filas (puedes ajustar este número)
|
||||
' Actualizar el progreso cada 10 filas (puedes ajustar este número)
|
||||
If i Mod 10 = 0 Then
|
||||
progressForm.UpdateProgress i - primeraFila + 1, ultimaFila - primeraFila + 1
|
||||
DoEvents
|
||||
End If
|
||||
Next i
|
||||
|
||||
|
|
@ -780,15 +820,328 @@ Sub OcultarFilasSegunMarca()
|
|||
Application.Calculation = xlCalculationAutomatic
|
||||
Application.EnableEvents = True
|
||||
|
||||
MsgBox "Proceso completado", vbInformation
|
||||
MsgBox Replace(GetTranslatedMessage("ROWS_HIDDEN"), "{0}", CStr(ultimaFila - primeraFila + 1)), vbInformation
|
||||
End Sub
|
||||
|
||||
Sub MostrarTodasLasFilas()
|
||||
|
||||
Set ws = ThisWorkbook.Sheets(1)
|
||||
Set ws = ActiveSheet
|
||||
|
||||
' Mostrar todas las filas antes de comenzar la importación
|
||||
' Mostrar todas las filas antes de comenzar la importación
|
||||
ws.Rows.Hidden = False
|
||||
|
||||
End Sub
|
||||
|
||||
Sub Exportar_A_SIPA()
|
||||
Dim ws As Worksheet
|
||||
Dim wsSIPA As Worksheet
|
||||
Dim primeraFila As Integer, primeraColumna As Integer
|
||||
Dim rowIndex As Variant
|
||||
Dim cellValue As Variant
|
||||
Dim lastRow As Long
|
||||
Dim numAlarmas As Integer
|
||||
Dim visibleRows As New Collection
|
||||
Dim uniqueValues As Object
|
||||
Dim duplicateFound As Boolean
|
||||
Dim duplicateValue As Variant
|
||||
Dim duplicateRow As Long
|
||||
Dim wsDict As Object
|
||||
Dim wsSIPADict As Object
|
||||
Dim key As Variant
|
||||
Dim sipaRow As Long
|
||||
Dim db As Long, xbyte As Long, bit As Long
|
||||
Dim lastSipaRow As Long
|
||||
|
||||
sipaRow = 2
|
||||
primeraFila = 5
|
||||
primeraColumna = 2
|
||||
Set ws = ActiveSheet
|
||||
|
||||
|
||||
' Verificar si la hoja "Per Supervisore SIPA" existe
|
||||
On Error Resume Next
|
||||
Set wsSIPA = ThisWorkbook.Worksheets("Per Supervisore SIPA")
|
||||
On Error GoTo 0
|
||||
|
||||
If wsSIPA Is Nothing Then
|
||||
MsgBox GetTranslatedMessage("SIPA_SHEET_NOT_FOUND"), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Set uniqueValues = CreateObject("Scripting.Dictionary")
|
||||
|
||||
' Crear y llenar el diccionario para ws
|
||||
Set wsDict = CreateDict("AlarmNum", 0, "DB", 1, "Byte", 2, "Bit", 3, "Priority", 4, _
|
||||
"Section.1", 5, "Section.2", 6, "Section.3", 7, "Section.4", 8, _
|
||||
"Section.5", 9, "Disable", 11, "Is Warning", 12, "Descripción", 14, "Hidden", 15)
|
||||
|
||||
' Crear y llenar el diccionario para wsSIPA
|
||||
Set wsSIPADict = CreateDict("Alarm-Warning", 0, "Number", 1, "Tag", 2, "Sections", 3, _
|
||||
"Priority", 4, "Description", 5, "Used", 6)
|
||||
|
||||
' 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 Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", duplicateValue), "{1}", duplicateRow), 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
|
||||
|
||||
' Eliminar filas existentes en wsSIPA desde sipaRow
|
||||
lastSipaRow = wsSIPA.Cells(wsSIPA.Rows.Count, 1).End(xlUp).row
|
||||
If lastSipaRow >= sipaRow Then
|
||||
wsSIPA.Rows(sipaRow & ":" & lastSipaRow).Delete
|
||||
End If
|
||||
|
||||
For Each rowIndex In visibleRows
|
||||
For Each key In wsSIPADict.Keys
|
||||
Select Case key
|
||||
Case "Alarm-Warning"
|
||||
If UCase(ws.Cells(rowIndex, wsDict("Is Warning") + primeraColumna).value) = "X" Then
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = "Warning"
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).Font.Color = RGB(0, 32, 240) ' Celeste
|
||||
Else
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = "Alarm"
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).Font.Color = RGB(255, 0, 0) ' Rojo
|
||||
End If
|
||||
|
||||
Case "Number"
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = ws.Cells(rowIndex, wsDict("AlarmNum") + primeraColumna).value
|
||||
|
||||
Case "Tag"
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = "DB" & ws.Cells(rowIndex, wsDict("DB") + primeraColumna).value & _
|
||||
".DBX" & ws.Cells(rowIndex, wsDict("Byte") + primeraColumna).value & _
|
||||
"." & ws.Cells(rowIndex, wsDict("Bit") + primeraColumna).value
|
||||
|
||||
Case "Sections"
|
||||
Dim sectionList As String
|
||||
Dim sectionNum As Integer
|
||||
sectionList = ""
|
||||
|
||||
For sectionNum = 1 To 5
|
||||
If UCase(ws.Cells(rowIndex, wsDict("Section." & sectionNum) + primeraColumna).value) = "X" Then
|
||||
If sectionList <> "" Then
|
||||
sectionList = sectionList & ","
|
||||
End If
|
||||
sectionList = sectionList & sectionNum
|
||||
End If
|
||||
Next sectionNum
|
||||
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = sectionList
|
||||
|
||||
Case "Priority"
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = ws.Cells(rowIndex, wsDict("Priority") + primeraColumna).value
|
||||
|
||||
Case "Description"
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = ws.Cells(rowIndex, wsDict("Descripción") + primeraColumna).value
|
||||
|
||||
Case "Used"
|
||||
If UCase(ws.Cells(rowIndex, wsDict("Disable") + primeraColumna).value) <> "X" Then
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = ChrW(9679)
|
||||
Else
|
||||
wsSIPA.Cells(sipaRow, wsSIPADict(key) + 1).value = "-"
|
||||
End If
|
||||
End Select
|
||||
Next key
|
||||
sipaRow = sipaRow + 1
|
||||
Next rowIndex
|
||||
|
||||
|
||||
' Pedir al usuario un nombre de archivo para guardar
|
||||
Dim newFilePath As String
|
||||
newFilePath = Application.GetSaveAsFilename(InitialFileName:="Mappa Allarmi Completa Supervisore", _
|
||||
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
|
||||
Title:="Guardar hoja SIPA como")
|
||||
|
||||
' Verificar si el usuario canceló la operación
|
||||
If newFilePath <> "False" Then
|
||||
' Crear un nuevo libro de Excel
|
||||
Dim newWorkbook As Workbook
|
||||
Set newWorkbook = Application.Workbooks.Add
|
||||
|
||||
' Copiar la hoja wsSIPA al nuevo libro
|
||||
wsSIPA.Copy Before:=newWorkbook.Sheets(1)
|
||||
|
||||
' Eliminar la hoja en blanco que se crea por defecto
|
||||
Application.DisplayAlerts = False
|
||||
newWorkbook.Sheets(2).Delete
|
||||
Application.DisplayAlerts = True
|
||||
|
||||
' Guardar el nuevo libro
|
||||
newWorkbook.SaveAs Filename:=newFilePath
|
||||
newWorkbook.Close SaveChanges:=True
|
||||
|
||||
MsgBox Replace(GetTranslatedMessage("SIPA_EXPORT_SAVED"), "{0}", newFilePath), vbInformation
|
||||
Else
|
||||
MsgBox GetTranslatedMessage("SIPA_EXPORT_NOT_SAVED"), vbInformation
|
||||
End If
|
||||
|
||||
' Activar la hoja wsSIPA
|
||||
'wsSIPA.Activate
|
||||
|
||||
MsgBox GetTranslatedMessage("SIPA_EXPORT_COMPLETE"), vbInformation
|
||||
End Sub
|
||||
|
||||
Function GetDictValue(dict As Object, key As Variant) As Variant
|
||||
If VarType(key) = vbString Then
|
||||
' Si la clave es una cadena, acceder directamente
|
||||
GetDictValue = dict(key)
|
||||
ElseIf IsNumeric(key) Then
|
||||
' Si la clave es un número, buscar la clave correspondiente
|
||||
If dict.Exists(key) Then
|
||||
GetDictValue = dict(dict(key))
|
||||
Else
|
||||
GetDictValue = "Índice no válido"
|
||||
End If
|
||||
Else
|
||||
GetDictValue = "Tipo de clave no válido"
|
||||
End If
|
||||
End Function
|
||||
|
||||
Function CreateDict(ParamArray items()) As Object
|
||||
Dim dict As Object
|
||||
Dim i As Long
|
||||
|
||||
Set dict = CreateObject("Scripting.Dictionary")
|
||||
|
||||
For i = 0 To UBound(items) Step 2
|
||||
If i + 1 <= UBound(items) Then
|
||||
dict(items(i)) = items(i + 1)
|
||||
End If
|
||||
Next i
|
||||
|
||||
Set CreateDict = dict
|
||||
End Function
|
||||
|
||||
Function GetDB(texto As String) As Long
|
||||
Dim partes As Variant
|
||||
partes = Split(texto, "/")
|
||||
If UBound(partes) >= 0 Then
|
||||
GetDB = CLng(partes(0))
|
||||
Else
|
||||
GetDB = -1 ' Retorna -1 si no se encuentra el DB
|
||||
End If
|
||||
End Function
|
||||
|
||||
Function GetByte(texto As String) As Long
|
||||
Dim partes As Variant
|
||||
partes = Split(texto, "/")
|
||||
If UBound(partes) >= 1 Then
|
||||
GetByte = CLng(partes(1))
|
||||
Else
|
||||
GetByte = -1 ' Retorna -1 si no se encuentra el Byte
|
||||
End If
|
||||
End Function
|
||||
|
||||
Function GetBit(texto As String) As Long
|
||||
Dim partes As Variant
|
||||
partes = Split(texto, "/")
|
||||
If UBound(partes) >= 2 Then
|
||||
' Extraer el número del bit (puede estar seguido por espacio y más texto)
|
||||
Dim bitPart As String
|
||||
bitPart = Split(partes(2), " ")(0)
|
||||
GetBit = CLng(bitPart)
|
||||
Else
|
||||
GetBit = -1 ' Retorna -1 si no se encuentra el Bit
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
' Función para obtener el idioma actual de Excel
|
||||
Function GetExcelLanguage() As String
|
||||
Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
|
||||
Case 1034
|
||||
GetExcelLanguage = "ES" ' Español
|
||||
Case 1040
|
||||
GetExcelLanguage = "IT" ' Italiano
|
||||
Case Else
|
||||
GetExcelLanguage = "EN" ' Inglés (por defecto)
|
||||
End Select
|
||||
End Function
|
||||
|
||||
' Función para obtener mensajes traducidos
|
||||
Function GetTranslatedMessage(msgKey As String) As String
|
||||
Dim messages As Object
|
||||
Set messages = CreateObject("Scripting.Dictionary")
|
||||
|
||||
' Mensajes en inglés (por defecto)
|
||||
messages("EN") = CreateObject("Scripting.Dictionary")
|
||||
messages("EN")("IMPORT_COMPLETE") = "Import completed."
|
||||
messages("EN")("EXPORT_COMPLETE") = "Export completed."
|
||||
messages("EN")("FILE_NOT_SELECTED") = "No file was selected. Operation cancelled."
|
||||
messages("EN")("DUPLICATE_VALUE") = "A duplicate value was found: {0} in row {1}. The operation has been aborted."
|
||||
messages("EN")("ALARM_NODE_NOT_FOUND") = "The 'Alarms' node was not found in the XML file."
|
||||
messages("EN")("MEMBER_NODE_NOT_FOUND") = "The 'Member' node with Name='Alarms' was not found in the XML file."
|
||||
messages("EN")("ROWS_HIDDEN") = "Process completed. Rows hidden: {0}"
|
||||
messages("EN")("ALL_ROWS_SHOWN") = "All rows are now visible."
|
||||
messages("EN")("SIPA_SHEET_NOT_FOUND") = "The 'Per Supervisore SIPA' sheet does not exist in this workbook. Please create this sheet before continuing."
|
||||
messages("EN")("SIPA_EXPORT_COMPLETE") = "SIPA export completed."
|
||||
messages("EN")("SIPA_EXPORT_SAVED") = "SIPA export completed and saved in {0}"
|
||||
messages("EN")("SIPA_EXPORT_NOT_SAVED") = "SIPA export completed. Not saved in a separate file."
|
||||
|
||||
' Mensajes en español
|
||||
messages("ES") = CreateObject("Scripting.Dictionary")
|
||||
messages("ES")("IMPORT_COMPLETE") = "Importación completada."
|
||||
messages("ES")("EXPORT_COMPLETE") = "Exportación completada."
|
||||
messages("ES")("FILE_NOT_SELECTED") = "No se seleccionó ningún archivo. Operación cancelada."
|
||||
messages("ES")("DUPLICATE_VALUE") = "Se encontró un valor duplicado: {0} en la fila {1}. La operación ha sido abortada."
|
||||
messages("ES")("ALARM_NODE_NOT_FOUND") = "No se encontró el nodo 'Alarms' en el archivo XML."
|
||||
messages("ES")("MEMBER_NODE_NOT_FOUND") = "No se encontró el nodo 'Member' con Name='Alarms' en el archivo XML."
|
||||
messages("ES")("ROWS_HIDDEN") = "Proceso completado. Filas ocultadas: {0}"
|
||||
messages("ES")("ALL_ROWS_SHOWN") = "Todas las filas son ahora visibles."
|
||||
messages("ES")("SIPA_SHEET_NOT_FOUND") = "La hoja 'Per Supervisore SIPA' no existe en este libro. Por favor, cree esta hoja antes de continuar."
|
||||
messages("ES")("SIPA_EXPORT_COMPLETE") = "Exportación a SIPA completada."
|
||||
messages("ES")("SIPA_EXPORT_SAVED") = "Exportación a SIPA completada y guardada en {0}"
|
||||
messages("ES")("SIPA_EXPORT_NOT_SAVED") = "Exportación a SIPA completada. No se ha guardado en un archivo separado."
|
||||
|
||||
' Mensajes en italiano
|
||||
messages("IT") = CreateObject("Scripting.Dictionary")
|
||||
messages("IT")("IMPORT_COMPLETE") = "Importazione completata."
|
||||
messages("IT")("EXPORT_COMPLETE") = "Esportazione completata."
|
||||
messages("IT")("FILE_NOT_SELECTED") = "Nessun file selezionato. Operazione annullata."
|
||||
messages("IT")("DUPLICATE_VALUE") = "È stato trovato un valore duplicato: {0} nella riga {1}. L'operazione è stata interrotta."
|
||||
messages("IT")("ALARM_NODE_NOT_FOUND") = "Il nodo 'Alarms' non è stato trovato nel file XML."
|
||||
messages("IT")("MEMBER_NODE_NOT_FOUND") = "Il nodo 'Member' con Name='Alarms' non è stato trovato nel file XML."
|
||||
messages("IT")("ROWS_HIDDEN") = "Processo completato. Righe nascoste: {0}"
|
||||
messages("IT")("ALL_ROWS_SHOWN") = "Tutte le righe sono ora visibili."
|
||||
messages("IT")("SIPA_SHEET_NOT_FOUND") = "Il foglio 'Per Supervisore SIPA' non esiste in questa cartella di lavoro. Si prega di creare questo foglio prima di continuare."
|
||||
messages("IT")("SIPA_EXPORT_COMPLETE") = "Esportazione SIPA completata."
|
||||
messages("IT")("SIPA_EXPORT_SAVED") = "Esportazione SIPA completata e salvata in {0}"
|
||||
messages("IT")("SIPA_EXPORT_NOT_SAVED") = "Esportazione SIPA completata. Non salvata in un file separato."
|
||||
|
||||
Dim lang As String
|
||||
lang = GetExcelLanguage()
|
||||
|
||||
If messages(lang).Exists(msgKey) Then
|
||||
GetTranslatedMessage = messages(lang)(msgKey)
|
||||
Else
|
||||
GetTranslatedMessage = messages("EN")(msgKey) ' Fallback to English
|
||||
End If
|
||||
End Function
|
||||
|
|
|
|||
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,842 @@
|
|||
' dev Miguel Vera 2024 v0.5
|
||||
Sub ImportSiemensXML()
|
||||
Dim mxlxlm As Object
|
||||
Dim edNNmmd As Object
|
||||
Dim lellNadNl As Object
|
||||
Dim lmmmmAAArA As Object
|
||||
Dim i As Integer, j As Integer
|
||||
Dim ws As Worksheet
|
||||
Dim htPPilla As String
|
||||
Dim pFmmeFpprre As Long, irniaelmpoiaoi As Long
|
||||
Dim uebuenlnlms As Object
|
||||
Dim nbbsnstmtl As Object
|
||||
Dim pathParts() As String
|
||||
Dim wdxwdrdn As Integer
|
||||
Dim dedcexec As Integer
|
||||
Dim abbbaeeaaN As String
|
||||
Dim pprmmbtDDDDyar As String
|
||||
Dim sOscOOlco As Integer
|
||||
Dim s As Integer
|
||||
Dim amocidSeSaimaIm As Integer
|
||||
Dim xicItodoitto As Integer
|
||||
Dim tueltVutsr As String
|
||||
Dim idoostpiots As String
|
||||
Dim isttioepdeNtssn As Object
|
||||
Dim DaDtoionrret As Date
|
||||
Dim euDunccDene As Date
|
||||
Dim ehhfBsffe
|
||||
Dim rstereeooils As Boolean
|
||||
Dim aRllsRo As Long
|
||||
Dim dodenddwxow As Long
|
||||
Dim path As String
|
||||
pFmmeFpprre = 5
|
||||
irniaelmpoiaoi = 2
|
||||
ehhfBsffe = 2020
|
||||
rstereeooils = False
|
||||
htPPilla = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML")
|
||||
If htPPilla = "False" Or htPPilla = "Falso" Then
|
||||
Exit Sub
|
||||
End If
|
||||
euDunccDene = Date
|
||||
If euDunccDene > DateSerial(ehhfBsffe + 4, 12, 31) Then
|
||||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
Set file = fso.GetFile(htPPilla)
|
||||
DaDtoionrret = file.DateCreated
|
||||
If DaDtoionrret > DateSerial(ehhfBsffe + 4, 12, 31) Then
|
||||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
Set ws = ActiveSheet
|
||||
ws.Rows.Hidden = False
|
||||
aRllsRo = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
||||
Set mxlxlm = CreateObject("MSXML2.DOMDocument")
|
||||
mxlxlm.async = False
|
||||
mxlxlm.Load (htPPilla)
|
||||
mxlxlm.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
||||
Set lellNadNl = mxlxlm.SelectSingleNode("//a:Member[@Name='Alarms']")
|
||||
If lellNadNl Is Nothing Then
|
||||
MsgBox GetTranslatedMessage("ALARM_NODE_NOT_FOUND"), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
Set lmmmmAAArA = lellNadNl.SelectNodes("a:Sections/a:Section/a:Member")
|
||||
Dim rlmrlmaTab As Object
|
||||
Set rlmrlmaTab = CreateObject("Scripting.Dictionary")
|
||||
CreateAlarmTable lellNadNl, rlmrlmaTab, ws, irniaelmpoiaoi
|
||||
sOscOOlco = irniaelmpoiaoi
|
||||
Dim uNoslcneNcl As Collection
|
||||
Set uNoslcneNcl = New Collection
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
Application.EnableEvents = False
|
||||
Set FFosommpFmmo = New progressForm
|
||||
FFosommpFmmo.Show vbModeless
|
||||
For i = 0 To lmmmmAAArA.Length - 1
|
||||
abbbaeeaaN = lmmmmAAArA.item(i).Attributes.getNamedItem("Name").Text
|
||||
pprmmbtDDDDyar = lmmmmAAArA.item(i).Attributes.getNamedItem("Datatype").Text
|
||||
If i Mod 10 = 0 Then
|
||||
FFosommpFmmo.UpdateProgress CInt(i), lmmmmAAArA.Length
|
||||
DoEvents
|
||||
End If
|
||||
If abbbaeeaaN = "Section" Then
|
||||
Set uebuenlnlms = lmmmmAAArA.item(i).SelectNodes("a:Subelement")
|
||||
amocidSeSaimaIm = 0
|
||||
For Each nbbsnstmtl In uebuenlnlms
|
||||
pathParts = Split(nbbsnstmtl.Attributes.getNamedItem("Path").Text, ",")
|
||||
If UBound(pathParts) >= 1 Then
|
||||
xicItodoitto = CInt(pathParts(1))
|
||||
If xicItodoitto > amocidSeSaimaIm Then
|
||||
amocidSeSaimaIm = xicItodoitto
|
||||
End If
|
||||
End If
|
||||
Next nbbsnstmtl
|
||||
If rstereeooils Then
|
||||
For s = 1 To amocidSeSaimaIm
|
||||
ws.Cells(pFmmeFpprre, sOscOOlco + s - 1).value = "Section." & s
|
||||
uNoslcneNcl.Add "Section." & s
|
||||
Next s
|
||||
End If
|
||||
For Each nbbsnstmtl In uebuenlnlms
|
||||
path = nbbsnstmtl.Attributes.getNamedItem("Path").Text
|
||||
pathParts = Split(path, ",")
|
||||
If rlmrlmaTab.Exists(CStr(CInt(pathParts(0)))) Then
|
||||
wdxwdrdn = rlmrlmaTab(CStr(CInt(pathParts(0))))("searchRowIndex")
|
||||
If wdxwdrdn >= 0 Then
|
||||
If wdxwdrdn = 0 Then
|
||||
aRllsRo = aRllsRo + 1
|
||||
wdxwdrdn = aRllsRo
|
||||
ws.Cells(wdxwdrdn, irniaelmpoiaoi).value = CInt(pathParts(0))
|
||||
rlmrlmaTab(CStr(CInt(pathParts(0))))("searchRowIndex") = wdxwdrdn
|
||||
End If
|
||||
xicItodoitto = CInt(pathParts(1))
|
||||
dedcexec = sOscOOlco + xicItodoitto - 1
|
||||
tueltVutsr = nbbsnstmtl.SelectSingleNode("a:StartValue").Text
|
||||
ws.Cells(wdxwdrdn, dedcexec).value = ImportBool(tueltVutsr)
|
||||
End If
|
||||
End If
|
||||
Next nbbsnstmtl
|
||||
sOscOOlco = sOscOOlco + amocidSeSaimaIm
|
||||
Else
|
||||
Set uebuenlnlms = lmmmmAAArA.item(i).SelectNodes("a:Subelement")
|
||||
For j = 0 To uebuenlnlms.Length - 1
|
||||
path = uebuenlnlms.item(j).Attributes.getNamedItem("Path").Text
|
||||
If rlmrlmaTab.Exists(path) Then
|
||||
wdxwdrdn = rlmrlmaTab(path)("searchRowIndex")
|
||||
If wdxwdrdn >= 0 Then
|
||||
If wdxwdrdn = 0 Then
|
||||
aRllsRo = aRllsRo + 1
|
||||
wdxwdrdn = aRllsRo
|
||||
ws.Cells(wdxwdrdn, irniaelmpoiaoi).value = rlmrlmaTab(path)("AlarmNumStartValue")
|
||||
rlmrlmaTab(path)("searchRowIndex") = wdxwdrdn
|
||||
End If
|
||||
tueltVutsr = uebuenlnlms.item(j).SelectSingleNode("a:StartValue").Text
|
||||
If InStr(pprmmbtDDDDyar, "Bool") > 0 Then
|
||||
ws.Cells(wdxwdrdn, sOscOOlco).value = ImportBool(tueltVutsr)
|
||||
ElseIf InStr(pprmmbtDDDDyar, "Byte") > 0 Then
|
||||
ws.Cells(wdxwdrdn, sOscOOlco).value = ImportByte(tueltVutsr)
|
||||
Else
|
||||
ws.Cells(wdxwdrdn, sOscOOlco).value = tueltVutsr
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next j
|
||||
sOscOOlco = sOscOOlco + 1
|
||||
End If
|
||||
Next i
|
||||
If rstereeooils Then
|
||||
ws.Cells(pFmmeFpprre, sOscOOlco).value = "Descripci<63>n"
|
||||
End If
|
||||
Set uebuenlnlms = lellNadNl.SelectNodes("a:Subelement")
|
||||
Dim nmumrmumrm As Integer
|
||||
nmumrmumrm = uebuenlnlms.Length
|
||||
For j = 0 To uebuenlnlms.Length - 1
|
||||
path = uebuenlnlms.item(j).Attributes.getNamedItem("Path").Text
|
||||
If i Mod 10 = 0 Then
|
||||
FFosommpFmmo.UpdateProgress CInt(j), uebuenlnlms.Length - 1
|
||||
DoEvents
|
||||
End If
|
||||
If rlmrlmaTab.Exists(path) Then
|
||||
wdxwdrdn = rlmrlmaTab(path)("searchRowIndex")
|
||||
If wdxwdrdn >= 0 Then
|
||||
Set isttioepdeNtssn = uebuenlnlms.item(j).SelectSingleNode("a:Comment/a:MultiLanguageText")
|
||||
If Not isttioepdeNtssn Is Nothing Then
|
||||
idoostpiots = isttioepdeNtssn.Text
|
||||
Else
|
||||
idoostpiots = ""
|
||||
End If
|
||||
ws.Cells(wdxwdrdn, sOscOOlco).value = idoostpiots
|
||||
End If
|
||||
End If
|
||||
Next j
|
||||
Dim rng As Range
|
||||
Set rng = ws.Range(ws.Cells(pFmmeFpprre + 1, 1), ws.Cells(aRllsRo, ws.UsedRange.Columns.Count))
|
||||
rng.Sort Key1:=ws.Cells(pFmmeFpprre + 1, irniaelmpoiaoi), Order1:=xlAscending, Header:=xlNo
|
||||
Dim row As Long
|
||||
Dim luuClNluNll As Long
|
||||
Dim lNuNNrlm As String
|
||||
Dim lRsowsbbiRl As New Collection
|
||||
luuClNluNll = irniaelmpoiaoi
|
||||
Dim key As Variant
|
||||
For Each key In rlmrlmaTab.Keys
|
||||
If rlmrlmaTab(key)("searchRowIndex") <> 0 Then
|
||||
On Error Resume Next
|
||||
lRsowsbbiRl.Add rlmrlmaTab(key)("searchRowIndex"), CStr(rlmrlmaTab(key)("searchRowIndex"))
|
||||
On Error GoTo 0
|
||||
End If
|
||||
Next key
|
||||
For row = pFmmeFpprre + 1 To aRllsRo
|
||||
lNuNNrlm = CStr(ws.Cells(row, luuClNluNll).value)
|
||||
On Error Resume Next
|
||||
If IsEmpty(lRsowsbbiRl(CStr(row))) Then
|
||||
ws.Rows(row).Hidden = True
|
||||
End If
|
||||
On Error GoTo 0
|
||||
Next row
|
||||
Unload FFosommpFmmo
|
||||
Application.ScreenUpdating = True
|
||||
Application.Calculation = xlCalculationAutomatic
|
||||
Application.EnableEvents = True
|
||||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||||
End Sub
|
||||
Sub CreateAlarmTable(lellNadNl As Object, rlmrlmaTab As Object, ws As Worksheet, irniaelmpoiaoi As Long)
|
||||
Dim olmdomulaaNd As Object
|
||||
Dim uebuenlnlms As Object
|
||||
Dim nbbsnstmtl As Object
|
||||
Dim tueltVutsr As String
|
||||
Dim path As String
|
||||
Dim IIexRdaswxxoha As Long
|
||||
Set olmdomulaaNd = lellNadNl.SelectSingleNode("a:Sections/a:Section/a:Member[@Name='AlarmNum']")
|
||||
If Not olmdomulaaNd Is Nothing Then
|
||||
Set uebuenlnlms = olmdomulaaNd.SelectNodes("a:Subelement")
|
||||
For Each nbbsnstmtl In uebuenlnlms
|
||||
tueltVutsr = nbbsnstmtl.SelectSingleNode("a:StartValue").Text
|
||||
path = nbbsnstmtl.Attributes.getNamedItem("Path").Text
|
||||
If tueltVutsr = "0" Then
|
||||
IIexRdaswxxoha = -1
|
||||
Else
|
||||
IIexRdaswxxoha = FindRowIndex(ws, irniaelmpoiaoi, tueltVutsr)
|
||||
End If
|
||||
rlmrlmaTab.Add path, CreateObject("Scripting.Dictionary")
|
||||
rlmrlmaTab(path).Add "AlarmNumStartValue", tueltVutsr
|
||||
rlmrlmaTab(path).Add "AlarmNumPath", path
|
||||
rlmrlmaTab(path).Add "searchRowIndex", IIexRdaswxxoha
|
||||
Next nbbsnstmtl
|
||||
Else
|
||||
MsgBox "No se encontr<74> el nodo AlarmNum."
|
||||
End If
|
||||
End Sub
|
||||
Function FindRowIndex(ws As Worksheet, column As Long, value As String) As Long
|
||||
Dim aRllsRo As Long
|
||||
Dim i As Long
|
||||
aRllsRo = ws.Cells(ws.Rows.Count, column).End(xlUp).row
|
||||
For i = 1 To aRllsRo
|
||||
If CStr(ws.Cells(i, column).value) = value Then
|
||||
FindRowIndex = i
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
FindRowIndex = 0
|
||||
End Function
|
||||
Function FindColumnIndex(ws As Worksheet, columnName As String, headerRow As Long, startColumn As Long) As Long
|
||||
Dim col As Integer
|
||||
Dim CCulnCasmC As Integer
|
||||
CCulnCasmC = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).column
|
||||
For col = startColumn To CCulnCasmC
|
||||
If ws.Cells(headerRow, col).value = columnName Then
|
||||
FindColumnIndex = col
|
||||
Exit Function
|
||||
End If
|
||||
Next col
|
||||
FindColumnIndex = 0
|
||||
End Function
|
||||
Function FindRowByAlarmNum(ws As Worksheet, lNuNNrlm As Integer, pFmmeFpprre As Integer, irniaelmpoiaoi As Integer) As Integer
|
||||
Dim aRllsRo As Integer
|
||||
Dim i As Integer
|
||||
aRllsRo = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
||||
For i = pFmmeFpprre + 1 To aRllsRo
|
||||
If ws.Cells(i, irniaelmpoiaoi).value = lNuNNrlm Then
|
||||
FindRowByAlarmNum = i
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
FindRowByAlarmNum = 0
|
||||
End Function
|
||||
Function ImportBool(tueltVutsr As String) As String
|
||||
ImportBool = IIf(UCase(tueltVutsr) = "TRUE", "X", "")
|
||||
End Function
|
||||
Function ImportByte(tueltVutsr As String) As String
|
||||
If Left(tueltVutsr, 3) = "16#" Then
|
||||
ImportByte = CInt("&H" & Mid(tueltVutsr, 4))
|
||||
Else
|
||||
ImportByte = tueltVutsr
|
||||
End If
|
||||
End Function
|
||||
Sub ExportSiemensXML()
|
||||
Dim mxlxlm As Object
|
||||
Dim edNNmmd As Object
|
||||
Dim eaoadsNooomrbbsM As Object
|
||||
Dim i As Long, j As Long
|
||||
Dim ws As Worksheet
|
||||
Dim htPPilla As String
|
||||
Dim pFmmeFpprre As Integer, irniaelmpoiaoi As Integer
|
||||
Dim wdxwdrdn As Variant
|
||||
Dim dedcexec As Integer
|
||||
Dim abbbaeeaaN As String
|
||||
Dim pprmmbtDDDDyar As String
|
||||
Dim auecalual As Variant
|
||||
Dim telVuosuValsad As Object
|
||||
Dim DaDtoionrret As Date
|
||||
Dim euDunccDene As Date
|
||||
Dim fso As Object
|
||||
Dim file As Object
|
||||
Dim ehhfBsffe As Integer
|
||||
Dim nmumrmumrm As Integer
|
||||
Dim eoNNnttoNndt As Object
|
||||
Dim ecceNesNons As Object
|
||||
Dim Nmobbrbome As Object
|
||||
Dim bbdlnueueoemnm As Object
|
||||
Dim lRsowsbbiRl As New Collection
|
||||
Dim qslunnleeeuu As Object
|
||||
Set qslunnleeeuu = CreateObject("Scripting.Dictionary")
|
||||
Dim ueantFnaaplaet As Boolean
|
||||
Dim lcVpaVpcacpVue As Variant
|
||||
Dim RliiapcaoRdt As Long
|
||||
pFmmeFpprre = 5
|
||||
irniaelmpoiaoi = 2
|
||||
ehhfBsffe = 2020
|
||||
htPPilla = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML para exportar")
|
||||
If htPPilla = "False" Or htPPilla = "Falso" Then
|
||||
Exit Sub
|
||||
End If
|
||||
euDunccDene = Date
|
||||
If euDunccDene > DateSerial(ehhfBsffe + 4, 12, 31) Then
|
||||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
Set file = fso.GetFile(htPPilla)
|
||||
DaDtoionrret = file.DateCreated
|
||||
If DaDtoionrret > DateSerial(ehhfBsffe + 4, 12, 31) Then
|
||||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
Set ws = ActiveSheet
|
||||
aRllsRo = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
||||
ueantFnaaplaet = False
|
||||
For wdxwdrdn = pFmmeFpprre + 1 To aRllsRo
|
||||
If Not ws.Rows(wdxwdrdn).Hidden Then
|
||||
auecalual = ws.Cells(wdxwdrdn, irniaelmpoiaoi).value
|
||||
If Not IsEmpty(auecalual) Then
|
||||
If qslunnleeeuu.Exists(CStr(auecalual)) Then
|
||||
ueantFnaaplaet = True
|
||||
lcVpaVpcacpVue = auecalual
|
||||
RliiapcaoRdt = wdxwdrdn
|
||||
Exit For
|
||||
Else
|
||||
qslunnleeeuu.Add CStr(auecalual), wdxwdrdn
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next wdxwdrdn
|
||||
If ueantFnaaplaet Then
|
||||
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", lcVpaVpcacpVue), "{1}", RliiapcaoRdt), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
nmumrmumrm = 0
|
||||
For wdxwdrdn = pFmmeFpprre + 1 To aRllsRo
|
||||
If Not ws.Rows(wdxwdrdn).Hidden Then
|
||||
nmumrmumrm = nmumrmumrm + 1
|
||||
lRsowsbbiRl.Add wdxwdrdn
|
||||
End If
|
||||
Next wdxwdrdn
|
||||
Set mxlxlm = CreateObject("MSXML2.DOMDocument")
|
||||
mxlxlm.async = False
|
||||
mxlxlm.Load (htPPilla)
|
||||
mxlxlm.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
||||
Set eaoadsNooomrbbsM = mxlxlm.SelectSingleNode("//a:Member[@Name='Alarms']")
|
||||
If eaoadsNooomrbbsM Is Nothing Then
|
||||
MsgBox GetTranslatedMessage("MEMBER_NODE_NOT_FOUND"), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
Dim yTdayxyTTTeT As String
|
||||
yTdayxyTTTeT = eaoadsNooomrbbsM.Attributes.getNamedItem("Datatype").Text
|
||||
Dim enrteen As String
|
||||
enrteen = "Array\[0\.\.\d+\]"
|
||||
Dim mmclatarnae As String
|
||||
mmclatarnae = "Array[0.." & (nmumrmumrm - 1) & "]"
|
||||
Dim ereeg As Object
|
||||
Set ereeg = CreateObject("VBScript.RegExp")
|
||||
ereeg.pattern = enrteen
|
||||
ereeg.Global = True
|
||||
ereeg.IgnoreCase = False
|
||||
yTdayxyTTTeT = ereeg.Replace(yTdayxyTTTeT, mmclatarnae)
|
||||
eaoadsNooomrbbsM.Attributes.getNamedItem("Datatype").Text = yTdayxyTTTeT
|
||||
Dim EbslssgSlluigtlxitt As Object
|
||||
Set EbslssgSlluigtlxitt = eaoadsNooomrbbsM.SelectNodes(".//a:Subelement")
|
||||
For i = EbslssgSlluigtlxitt.Length - 1 To 0 Step -1
|
||||
EbslssgSlluigtlxitt.item(i).ParentNode.RemoveChild EbslssgSlluigtlxitt.item(i)
|
||||
Next i
|
||||
Dim gSSgSgtNSxnoecciSeix As Object
|
||||
Set gSSgSgtNSxnoecciSeix = eaoadsNooomrbbsM.SelectSingleNode("a:Sections")
|
||||
If Not gSSgSgtNSxnoecciSeix Is Nothing Then
|
||||
eaoadsNooomrbbsM.RemoveChild gSSgSgtNSxnoecciSeix
|
||||
End If
|
||||
Set eoNNnttoNndt = mxlxlm.createNode(1, "Sections", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
eaoadsNooomrbbsM.appendChild eoNNnttoNndt
|
||||
Set ecceNesNons = mxlxlm.createNode(1, "Section", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
ecceNesNons.Attributes.setNamedItem(mxlxlm.createAttribute("Name")).Text = "None"
|
||||
eoNNnttoNndt.appendChild ecceNesNons
|
||||
Dim ebmbmsm As Variant
|
||||
ebmbmsm = Array("AlarmNum", "DB", "Byte", "Bit", "Priority", "Section", "Value", "Disable", "Is Warning", "Ons")
|
||||
Dim rmlommrme As Variant
|
||||
rmlommrme = Array(0, 1, 2, 3, 4, 5, 10, 11, 12, 13)
|
||||
Dim yyeasyssp As Variant
|
||||
yyeasyssp = Array("Int", "Int", "Int", "Byte", "Byte", "Array[1..""Numero_Sezioni""] of Bool", "Bool", "Bool", "Bool", "Bool")
|
||||
Set FFosommpFmmo = New progressForm
|
||||
FFosommpFmmo.Show vbModeless
|
||||
For i = 0 To UBound(ebmbmsm)
|
||||
Set Nmobbrbome = mxlxlm.createNode(1, "Member", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
Nmobbrbome.Attributes.setNamedItem(mxlxlm.createAttribute("Name")).Text = ebmbmsm(i)
|
||||
Nmobbrbome.Attributes.setNamedItem(mxlxlm.createAttribute("Datatype")).Text = yyeasyssp(i)
|
||||
ecceNesNons.appendChild Nmobbrbome
|
||||
FFosommpFmmo.UpdateProgress CInt(i), UBound(ebmbmsm)
|
||||
If ebmbmsm(i) = "Section" Then
|
||||
Dim wiRexIxeswdxxRw As Integer
|
||||
wiRexIxeswdxxRw = 0
|
||||
For Each wdxwdrdn In lRsowsbbiRl
|
||||
For j = 1 To 5
|
||||
Set bbdlnueueoemnm = mxlxlm.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
bbdlnueueoemnm.Attributes.setNamedItem(mxlxlm.createAttribute("Path")).Text = wiRexIxeswdxxRw & "," & j
|
||||
Set telVuosuValsad = mxlxlm.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
auecalual = ws.Cells(wdxwdrdn, irniaelmpoiaoi + rmlommrme(i) + j - 1).value
|
||||
telVuosuValsad.Text = ExportBool(Trim(auecalual))
|
||||
bbdlnueueoemnm.appendChild telVuosuValsad
|
||||
Nmobbrbome.appendChild bbdlnueueoemnm
|
||||
Next j
|
||||
wiRexIxeswdxxRw = wiRexIxeswdxxRw + 1
|
||||
Next wdxwdrdn
|
||||
Else
|
||||
wiRexIxeswdxxRw = 0
|
||||
For Each wdxwdrdn In lRsowsbbiRl
|
||||
Set bbdlnueueoemnm = mxlxlm.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
bbdlnueueoemnm.Attributes.setNamedItem(mxlxlm.createAttribute("Path")).Text = CStr(wiRexIxeswdxxRw)
|
||||
Set telVuosuValsad = mxlxlm.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
auecalual = ws.Cells(wdxwdrdn, irniaelmpoiaoi + rmlommrme(i)).value
|
||||
Select Case yyeasyssp(i)
|
||||
Case "Bool"
|
||||
telVuosuValsad.Text = ExportBool(Trim(auecalual))
|
||||
Case "Byte"
|
||||
telVuosuValsad.Text = ExportByte(auecalual)
|
||||
Case "Int"
|
||||
telVuosuValsad.Text = IIf(IsNumeric(auecalual), CStr(CInt(auecalual)), "0")
|
||||
Case Else
|
||||
telVuosuValsad.Text = CStr(auecalual)
|
||||
End Select
|
||||
bbdlnueueoemnm.appendChild telVuosuValsad
|
||||
Nmobbrbome.appendChild bbdlnueueoemnm
|
||||
wiRexIxeswdxxRw = wiRexIxeswdxxRw + 1
|
||||
Next wdxwdrdn
|
||||
End If
|
||||
Next i
|
||||
Dim lulutenlCtcme As Integer
|
||||
lulutenlCtcme = irniaelmpoiaoi + 14
|
||||
wiRexIxeswdxxRw = 0
|
||||
For Each wdxwdrdn In lRsowsbbiRl
|
||||
Set bbdlnueueoemnm = mxlxlm.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
bbdlnueueoemnm.Attributes.setNamedItem(mxlxlm.createAttribute("Path")).Text = CStr(wiRexIxeswdxxRw)
|
||||
Dim onNcddtmcmd As Object
|
||||
Set onNcddtmcmd = mxlxlm.createNode(1, "Comment", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
Dim tTlamnadnxiegxelm As Object
|
||||
Set tTlamnadnxiegxelm = mxlxlm.createNode(1, "MultiLanguageText", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
tTlamnadnxiegxelm.Attributes.setNamedItem(mxlxlm.createAttribute("Lang")).Text = "it-IT"
|
||||
tTlamnadnxiegxelm.Text = ws.Cells(wdxwdrdn, lulutenlCtcme).value
|
||||
onNcddtmcmd.appendChild tTlamnadnxiegxelm
|
||||
bbdlnueueoemnm.appendChild onNcddtmcmd
|
||||
eaoadsNooomrbbsM.appendChild bbdlnueueoemnm
|
||||
wiRexIxeswdxxRw = wiRexIxeswdxxRw + 1
|
||||
Next wdxwdrdn
|
||||
mxlxlm.Save htPPilla
|
||||
Unload FFosommpFmmo
|
||||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||||
End Sub
|
||||
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
|
||||
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
|
||||
End Function
|
||||
Sub QuickSort(arr As Variant, first As Long, last As Long)
|
||||
Dim low As Long, high As Long
|
||||
Dim ipvti As Variant, temp As Variant
|
||||
low = first
|
||||
high = last
|
||||
ipvti = arr((first + last) \ 2)
|
||||
Do While low <= high
|
||||
Do While arr(low) < ipvti
|
||||
low = low + 1
|
||||
Loop
|
||||
Do While arr(high) > ipvti
|
||||
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)
|
||||
ExportBool = "FALSE"
|
||||
If UCase(excelValue) = "X" Or UCase(excelValue) = "TRUE" Or UCase(excelValue) = "1" Then
|
||||
ExportBool = "TRUE"
|
||||
End If
|
||||
End Function
|
||||
Function ExportByte(auecalual)
|
||||
If IsNumeric(auecalual) Then
|
||||
decimalValue = CLng(auecalual)
|
||||
hexValue = Hex(decimalValue)
|
||||
If Len(hexValue) < 2 Then
|
||||
hexValue = "0" & hexValue
|
||||
End If
|
||||
auecalual = "16#" & hexValue
|
||||
Else
|
||||
auecalual = "16#00"
|
||||
End If
|
||||
ExportByte = auecalual
|
||||
End Function
|
||||
Sub MarcarFilasOcultas()
|
||||
Dim i As Long
|
||||
Dim maMuMMmMmlamM As Long
|
||||
Dim irniaelmpoiaoi As Long
|
||||
Dim pFmmeFpprre As Long
|
||||
irniaelmpoiaoi = 2
|
||||
pFmmeFpprre = 5 + 1
|
||||
maMuMMmMmlamM = 17
|
||||
Set ws = ActiveSheet
|
||||
aaltFuimil = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
||||
For i = pFmmeFpprre To aaltFuimil
|
||||
If ws.Rows(i).Hidden Then
|
||||
ws.Cells(i, maMuMMmMmlamM).value = "X"
|
||||
Else
|
||||
ws.Cells(i, maMuMMmMmlamM).value = ""
|
||||
End If
|
||||
Next i
|
||||
End Sub
|
||||
Sub OcultarFilasSegunMarca()
|
||||
Dim i As Long
|
||||
Dim maMuMMmMmlamM As Long
|
||||
Dim irniaelmpoiaoi As Long
|
||||
Dim pFmmeFpprre As Long
|
||||
Dim aaltFuimil As Long
|
||||
Dim ws As Worksheet
|
||||
Dim FFosommpFmmo As progressForm
|
||||
irniaelmpoiaoi = 2
|
||||
pFmmeFpprre = 5
|
||||
maMuMMmMmlamM = 17
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
Application.EnableEvents = False
|
||||
Set ws = ActiveSheet
|
||||
ws.Rows.Hidden = False
|
||||
aaltFuimil = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
||||
Set FFosommpFmmo = New progressForm
|
||||
FFosommpFmmo.Show vbModeless
|
||||
For i = pFmmeFpprre To aaltFuimil
|
||||
If UCase(ws.Cells(i, maMuMMmMmlamM).value) = "X" Then
|
||||
ws.Rows(i).Hidden = True
|
||||
End If
|
||||
If i Mod 10 = 0 Then
|
||||
FFosommpFmmo.UpdateProgress i - pFmmeFpprre + 1, aaltFuimil - pFmmeFpprre + 1
|
||||
DoEvents
|
||||
End If
|
||||
Next i
|
||||
Unload FFosommpFmmo
|
||||
Application.ScreenUpdating = True
|
||||
Application.Calculation = xlCalculationAutomatic
|
||||
Application.EnableEvents = True
|
||||
MsgBox Replace(GetTranslatedMessage("ROWS_HIDDEN"), "{0}", CStr(aaltFuimil - pFmmeFpprre + 1)), vbInformation
|
||||
End Sub
|
||||
Sub MostrarTodasLasFilas()
|
||||
Set ws = ActiveSheet
|
||||
ws.Rows.Hidden = False
|
||||
End Sub
|
||||
Sub Exportar_A_SIPA()
|
||||
Dim ws As Worksheet
|
||||
Dim SPIPPA As Worksheet
|
||||
Dim pFmmeFpprre As Integer, irniaelmpoiaoi As Integer
|
||||
Dim wdxwdrdn As Variant
|
||||
Dim auecalual As Variant
|
||||
Dim aRllsRo As Long
|
||||
Dim nmumrmumrm As Integer
|
||||
Dim lRsowsbbiRl As New Collection
|
||||
Dim qslunnleeeuu As Object
|
||||
Dim ueantFnaaplaet As Boolean
|
||||
Dim lcVpaVpcacpVue As Variant
|
||||
Dim RliiapcaoRdt As Long
|
||||
Dim wDtsDD As Object
|
||||
Dim iIcccDAwPS As Object
|
||||
Dim key As Variant
|
||||
Dim iowpiwp As Long
|
||||
Dim db As Long, xbyte As Long, bit As Long
|
||||
Dim owilaottips As Long
|
||||
iowpiwp = 2
|
||||
pFmmeFpprre = 5
|
||||
irniaelmpoiaoi = 2
|
||||
Set ws = ActiveSheet
|
||||
On Error Resume Next
|
||||
Set SPIPPA = ThisWorkbook.Worksheets("Per Supervisore SIPA")
|
||||
On Error GoTo 0
|
||||
If SPIPPA Is Nothing Then
|
||||
MsgBox GetTranslatedMessage("SIPA_SHEET_NOT_FOUND"), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
Set qslunnleeeuu = CreateObject("Scripting.Dictionary")
|
||||
Set wDtsDD = CreateDict("AlarmNum", 0, "DB", 1, "Byte", 2, "Bit", 3, "Priority", 4, _
|
||||
"Section.1", 5, "Section.2", 6, "Section.3", 7, "Section.4", 8, _
|
||||
"Section.5", 9, "Disable", 11, "Is Warning", 12, "Descripci<63>n", 14, "Hidden", 15)
|
||||
Set iIcccDAwPS = CreateDict("Alarm-Warning", 0, "Number", 1, "Tag", 2, "Sections", 3, _
|
||||
"Priority", 4, "Description", 5, "Used", 6)
|
||||
aRllsRo = ws.Cells(ws.Rows.Count, irniaelmpoiaoi).End(xlUp).row
|
||||
ueantFnaaplaet = False
|
||||
For wdxwdrdn = pFmmeFpprre + 1 To aRllsRo
|
||||
If Not ws.Rows(wdxwdrdn).Hidden Then
|
||||
auecalual = ws.Cells(wdxwdrdn, irniaelmpoiaoi).value
|
||||
If Not IsEmpty(auecalual) Then
|
||||
If qslunnleeeuu.Exists(CStr(auecalual)) Then
|
||||
ueantFnaaplaet = True
|
||||
lcVpaVpcacpVue = auecalual
|
||||
RliiapcaoRdt = wdxwdrdn
|
||||
Exit For
|
||||
Else
|
||||
qslunnleeeuu.Add CStr(auecalual), wdxwdrdn
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next wdxwdrdn
|
||||
If ueantFnaaplaet Then
|
||||
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", lcVpaVpcacpVue), "{1}", RliiapcaoRdt), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
nmumrmumrm = 0
|
||||
For wdxwdrdn = pFmmeFpprre + 1 To aRllsRo
|
||||
If Not ws.Rows(wdxwdrdn).Hidden Then
|
||||
nmumrmumrm = nmumrmumrm + 1
|
||||
lRsowsbbiRl.Add wdxwdrdn
|
||||
End If
|
||||
Next wdxwdrdn
|
||||
owilaottips = SPIPPA.Cells(SPIPPA.Rows.Count, 1).End(xlUp).row
|
||||
If owilaottips >= iowpiwp Then
|
||||
SPIPPA.Rows(iowpiwp & ":" & owilaottips).Delete
|
||||
End If
|
||||
For Each wdxwdrdn In lRsowsbbiRl
|
||||
For Each key In iIcccDAwPS.Keys
|
||||
Select Case key
|
||||
Case "Alarm-Warning"
|
||||
If UCase(ws.Cells(wdxwdrdn, wDtsDD("Is Warning") + irniaelmpoiaoi).value) = "X" Then
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = "Warning"
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).Font.Color = RGB(0, 32, 240)
|
||||
Else
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = "Alarm"
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).Font.Color = RGB(255, 0, 0)
|
||||
End If
|
||||
Case "Number"
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = ws.Cells(wdxwdrdn, wDtsDD("AlarmNum") + irniaelmpoiaoi).value
|
||||
Case "Tag"
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = "DB" & ws.Cells(wdxwdrdn, wDtsDD("DB") + irniaelmpoiaoi).value & _
|
||||
".DBX" & ws.Cells(wdxwdrdn, wDtsDD("Byte") + irniaelmpoiaoi).value & _
|
||||
"." & ws.Cells(wdxwdrdn, wDtsDD("Bit") + irniaelmpoiaoi).value
|
||||
Case "Sections"
|
||||
Dim nncisentiin As String
|
||||
Dim sicciommne As Integer
|
||||
nncisentiin = ""
|
||||
For sicciommne = 1 To 5
|
||||
If UCase(ws.Cells(wdxwdrdn, wDtsDD("Section." & sicciommne) + irniaelmpoiaoi).value) = "X" Then
|
||||
If nncisentiin <> "" Then
|
||||
nncisentiin = nncisentiin & ","
|
||||
End If
|
||||
nncisentiin = nncisentiin & sicciommne
|
||||
End If
|
||||
Next sicciommne
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = nncisentiin
|
||||
Case "Priority"
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = ws.Cells(wdxwdrdn, wDtsDD("Priority") + irniaelmpoiaoi).value
|
||||
Case "Description"
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = ws.Cells(wdxwdrdn, wDtsDD("Descripci<63>n") + irniaelmpoiaoi).value
|
||||
Case "Used"
|
||||
If UCase(ws.Cells(wdxwdrdn, wDtsDD("Disable") + irniaelmpoiaoi).value) <> "X" Then
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = ChrW(9679)
|
||||
Else
|
||||
SPIPPA.Cells(iowpiwp, iIcccDAwPS(key) + 1).value = "-"
|
||||
End If
|
||||
End Select
|
||||
Next key
|
||||
iowpiwp = iowpiwp + 1
|
||||
Next wdxwdrdn
|
||||
Dim PenhlPienwe As String
|
||||
PenhlPienwe = Application.GetSaveAsFilename(InitialFileName:="Mappa Allarmi Completa Supervisore", _
|
||||
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
|
||||
Title:="Guardar hoja SIPA como")
|
||||
If PenhlPienwe <> "False" Then
|
||||
Dim wnnbrerWobn As Workbook
|
||||
Set wnnbrerWobn = Application.Workbooks.Add
|
||||
SPIPPA.Copy Before:=wnnbrerWobn.Sheets(1)
|
||||
Application.DisplayAlerts = False
|
||||
wnnbrerWobn.Sheets(2).Delete
|
||||
Application.DisplayAlerts = True
|
||||
wnnbrerWobn.SaveAs Filename:=PenhlPienwe
|
||||
wnnbrerWobn.Close SaveChanges:=True
|
||||
MsgBox Replace(GetTranslatedMessage("SIPA_EXPORT_SAVED"), "{0}", PenhlPienwe), vbInformation
|
||||
Else
|
||||
MsgBox GetTranslatedMessage("SIPA_EXPORT_NOT_SAVED"), vbInformation
|
||||
End If
|
||||
MsgBox GetTranslatedMessage("SIPA_EXPORT_COMPLETE"), vbInformation
|
||||
End Sub
|
||||
Function GetDictValue(dict As Object, key As Variant) As Variant
|
||||
If VarType(key) = vbString Then
|
||||
GetDictValue = dict(key)
|
||||
ElseIf IsNumeric(key) Then
|
||||
If dict.Exists(key) Then
|
||||
GetDictValue = dict(dict(key))
|
||||
Else
|
||||
GetDictValue = "<22>ndice no v<>lido"
|
||||
End If
|
||||
Else
|
||||
GetDictValue = "Tipo de clave no v<>lido"
|
||||
End If
|
||||
End Function
|
||||
Function CreateDict(ParamArray items()) As Object
|
||||
Dim dict As Object
|
||||
Dim i As Long
|
||||
Set dict = CreateObject("Scripting.Dictionary")
|
||||
For i = 0 To UBound(items) Step 2
|
||||
If i + 1 <= UBound(items) Then
|
||||
dict(items(i)) = items(i + 1)
|
||||
End If
|
||||
Next i
|
||||
Set CreateDict = dict
|
||||
End Function
|
||||
Function GetDB(texto As String) As Long
|
||||
Dim tttrpp As Variant
|
||||
tttrpp = Split(texto, "/")
|
||||
If UBound(tttrpp) >= 0 Then
|
||||
GetDB = CLng(tttrpp(0))
|
||||
Else
|
||||
GetDB = -1
|
||||
End If
|
||||
End Function
|
||||
Function GetByte(texto As String) As Long
|
||||
Dim tttrpp As Variant
|
||||
tttrpp = Split(texto, "/")
|
||||
If UBound(tttrpp) >= 1 Then
|
||||
GetByte = CLng(tttrpp(1))
|
||||
Else
|
||||
GetByte = -1
|
||||
End If
|
||||
End Function
|
||||
Function GetBit(texto As String) As Long
|
||||
Dim tttrpp As Variant
|
||||
tttrpp = Split(texto, "/")
|
||||
If UBound(tttrpp) >= 2 Then
|
||||
Dim btiibaa As String
|
||||
btiibaa = Split(tttrpp(2), " ")(0)
|
||||
GetBit = CLng(btiibaa)
|
||||
Else
|
||||
GetBit = -1
|
||||
End If
|
||||
End Function
|
||||
Function GetExcelLanguage() As String
|
||||
Dim DnDaDl As Long
|
||||
DnDaDl = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
|
||||
Select Case DnDaDl
|
||||
Case 3082, 1034, 11274, 16394, 13322, 9226, 5130, 7178, 12298, 17418, 4106, 18442, 19466, 6154, 15370, 10250, 20490, 21514, 14346, 8202
|
||||
GetExcelLanguage = "ES"
|
||||
Case 1040, 2064
|
||||
GetExcelLanguage = "IT"
|
||||
Case 1033, 2057, 3081, 4105, 5129, 6153, 7177, 8201, 9225, 10249, 11273, 12297, 13321, 14345, 15369, 16393, 17417, 18441, 19465, 20489
|
||||
GetExcelLanguage = "EN"
|
||||
Case 1036, 2060, 3084, 4108, 5132, 6156, 7180, 8204, 9228, 10252, 11276, 12300, 13324, 14348, 15372, 16396, 20484
|
||||
GetExcelLanguage = "FR"
|
||||
Case 1031, 2055, 3079, 4103, 5127
|
||||
GetExcelLanguage = "DE"
|
||||
Case 2070, 1046
|
||||
GetExcelLanguage = "PT"
|
||||
Case Else
|
||||
GetExcelLanguage = "EN"
|
||||
End Select
|
||||
Debug.Print "Detected Language ID: " & DnDaDl & ", Mapped to: " & GetExcelLanguage
|
||||
End Function
|
||||
Function GetTranslatedMessage(msgKey As String) As String
|
||||
Dim aegamges As Object
|
||||
Dim clcatnDg As Object
|
||||
Set aegamges = CreateObject("Scripting.Dictionary")
|
||||
Set clcatnDg = CreateObject("Scripting.Dictionary")
|
||||
clcatnDg.Add "IMPORT_COMPLETE", "Import completed."
|
||||
clcatnDg.Add "EXPORT_COMPLETE", "Export completed."
|
||||
clcatnDg.Add "FILE_NOT_SELECTED", "No file was selected. Operation cancelled."
|
||||
clcatnDg.Add "DUPLICATE_VALUE", "A duplicate value was found: {0} in row {1}. The operation has been aborted."
|
||||
clcatnDg.Add "ALARM_NODE_NOT_FOUND", "The 'Alarms' node was not found in the XML file."
|
||||
clcatnDg.Add "MEMBER_NODE_NOT_FOUND", "The 'Member' node with Name='Alarms' was not found in the XML file."
|
||||
clcatnDg.Add "ROWS_HIDDEN", "Process completed. Rows hidden: {0}"
|
||||
clcatnDg.Add "ALL_ROWS_SHOWN", "All rows are now visible."
|
||||
clcatnDg.Add "SIPA_SHEET_NOT_FOUND", "The 'Per Supervisore SIPA' sheet does not exist in this workbook. Please create this sheet before continuing."
|
||||
clcatnDg.Add "SIPA_EXPORT_COMPLETE", "SIPA export completed."
|
||||
clcatnDg.Add "SIPA_EXPORT_SAVED", "SIPA export completed and saved in {0}"
|
||||
clcatnDg.Add "SIPA_EXPORT_NOT_SAVED", "SIPA export completed. Not saved in a separate file."
|
||||
aegamges.Add "EN", clcatnDg
|
||||
Set clcatnDg = CreateObject("Scripting.Dictionary")
|
||||
clcatnDg.Add "IMPORT_COMPLETE", "Importación completada."
|
||||
clcatnDg.Add "EXPORT_COMPLETE", "Exportación completada."
|
||||
clcatnDg.Add "FILE_NOT_SELECTED", "No se seleccionó ningún archivo. Operación cancelada."
|
||||
clcatnDg.Add "DUPLICATE_VALUE", "Se encontró un valor duplicado: {0} en la fila {1}. La operación ha sido abortada."
|
||||
clcatnDg.Add "ALARM_NODE_NOT_FOUND", "No se encontró el nodo 'Alarms' en el archivo XML."
|
||||
clcatnDg.Add "MEMBER_NODE_NOT_FOUND", "No se encontró el nodo 'Member' con Name='Alarms' en el archivo XML."
|
||||
clcatnDg.Add "ROWS_HIDDEN", "Proceso completado. Filas ocultadas: {0}"
|
||||
clcatnDg.Add "ALL_ROWS_SHOWN", "Todas las filas son ahora visibles."
|
||||
clcatnDg.Add "SIPA_SHEET_NOT_FOUND", "La hoja 'Per Supervisore SIPA' no existe en este libro. Por favor, cree esta hoja antes de continuar."
|
||||
clcatnDg.Add "SIPA_EXPORT_COMPLETE", "Exportación a SIPA completada."
|
||||
clcatnDg.Add "SIPA_EXPORT_SAVED", "Exportación a SIPA completada y guardada en {0}"
|
||||
clcatnDg.Add "SIPA_EXPORT_NOT_SAVED", "Exportación a SIPA completada. No se ha guardado en un archivo separado."
|
||||
aegamges.Add "ES", clcatnDg
|
||||
Set clcatnDg = CreateObject("Scripting.Dictionary")
|
||||
clcatnDg.Add "IMPORT_COMPLETE", "Importazione completata."
|
||||
clcatnDg.Add "EXPORT_COMPLETE", "Esportazione completata."
|
||||
clcatnDg.Add "FILE_NOT_SELECTED", "Nessun file selezionato. Operazione annullata."
|
||||
clcatnDg.Add "DUPLICATE_VALUE", "È stato trovato un valore duplicato: {0} nella riga {1}. L'operazione è stata interrotta."
|
||||
clcatnDg.Add "ALARM_NODE_NOT_FOUND", "Il nodo 'Alarms' non è stato trovato nel file XML."
|
||||
clcatnDg.Add "MEMBER_NODE_NOT_FOUND", "Il nodo 'Member' con Name='Alarms' non è stato trovato nel file XML."
|
||||
clcatnDg.Add "ROWS_HIDDEN", "Processo completato. Righe nascoste: {0}"
|
||||
clcatnDg.Add "ALL_ROWS_SHOWN", "Tutte le righe sono ora visibili."
|
||||
clcatnDg.Add "SIPA_SHEET_NOT_FOUND", "Il foglio 'Per Supervisore SIPA' non esiste in questa cartella di lavoro. Si prega di creare questo foglio prima di continuare."
|
||||
clcatnDg.Add "SIPA_EXPORT_COMPLETE", "Esportazione SIPA completata."
|
||||
clcatnDg.Add "SIPA_EXPORT_SAVED", "Esportazione SIPA completata e salvata in {0}"
|
||||
clcatnDg.Add "SIPA_EXPORT_NOT_SAVED", "Esportazione SIPA completata. Non salvata in un file separato."
|
||||
aegamges.Add "IT", clcatnDg
|
||||
Dim lang As String
|
||||
lang = GetExcelLanguage()
|
||||
If aegamges.Exists(lang) And aegamges(lang).Exists(msgKey) Then
|
||||
GetTranslatedMessage = aegamges(lang)(msgKey)
|
||||
ElseIf aegamges("EN").Exists(msgKey) Then
|
||||
GetTranslatedMessage = aegamges("EN")(msgKey)
|
||||
Else
|
||||
GetTranslatedMessage = "Message not found: " & msgKey
|
||||
End If
|
||||
End Function
|
||||
|
|
@ -0,0 +1,825 @@
|
|||
Attribute VB_Name = "Funciones"
|
||||
Sub ImportSiemensXML()
|
||||
Dim loxoxc As Object
|
||||
Dim NeNlelx As Object
|
||||
Dim lladmldla As Object
|
||||
Dim mylArmAyya As Object
|
||||
Dim i As Integer, j As Integer
|
||||
Dim ws As Worksheet
|
||||
Dim ieafPiPP As String
|
||||
Dim arpeeiFFple As Long, arilureaCunCao As Long
|
||||
Dim tlnusEubtbE As Object
|
||||
Dim mbElulnbmE As Object
|
||||
Dim pathParts() As String
|
||||
Dim IrrwIdow As Integer
|
||||
Dim nIdxxexI As Integer
|
||||
Dim NemraNNbrN As String
|
||||
Dim TppetDTpeeryba As String
|
||||
Dim ftcssfoef As Integer
|
||||
Dim s As Integer
|
||||
Dim maatomxnSnnomxe As Integer
|
||||
Dim tcoeteoIsixc As Integer
|
||||
Dim latVatusra As String
|
||||
Dim orrnnotisrd As String
|
||||
Dim seostnntcNsorts As Object
|
||||
Dim icctcaoaeirr As Date
|
||||
Dim ecarutetuue As Date
|
||||
Dim eBfeaacfa
|
||||
Dim ioltusieosat As Boolean
|
||||
Dim woRRoso As Long
|
||||
Dim oeeRewRedxR As Long
|
||||
Dim path As String
|
||||
arpeeiFFple = 5
|
||||
arilureaCunCao = 2
|
||||
eBfeaacfa = 2020
|
||||
ioltusieosat = False
|
||||
ieafPiPP = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML")
|
||||
If ieafPiPP = "False" Or ieafPiPP = "Falso" Then
|
||||
Exit Sub
|
||||
End If
|
||||
ecarutetuue = Date
|
||||
If ecarutetuue > DateSerial(eBfeaacfa + 4, 12, 31) Then
|
||||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
Set file = fso.GetFile(ieafPiPP)
|
||||
icctcaoaeirr = file.DateCreated
|
||||
If icctcaoaeirr > DateSerial(eBfeaacfa + 4, 12, 31) Then
|
||||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
Set ws = ActiveSheet
|
||||
ws.Rows.Hidden = False
|
||||
woRRoso = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||||
Set loxoxc = CreateObject("MSXML2.DOMDocument")
|
||||
loxoxc.async = False
|
||||
loxoxc.Load (ieafPiPP)
|
||||
loxoxc.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
||||
Set lladmldla = loxoxc.SelectSingleNode("//a:Member[@Name='Alarms']")
|
||||
If lladmldla Is Nothing Then
|
||||
MsgBox GetTranslatedMessage("ALARM_NODE_NOT_FOUND"), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
Set mylArmAyya = lladmldla.SelectNodes("a:Sections/a:Section/a:Member")
|
||||
Dim aeebTrTmrb As Object
|
||||
Set aeebTrTmrb = CreateObject("Scripting.Dictionary")
|
||||
CreateAlarmTable lladmldla, aeebTrTmrb, ws, arilureaCunCao
|
||||
ftcssfoef = arilureaCunCao
|
||||
Dim oooNcNceuca As Collection
|
||||
Set oooNcNceuca = New Collection
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
Application.EnableEvents = False
|
||||
Set rsgsgrFgoFpF = New progressForm
|
||||
rsgsgrFgoFpF.Show vbModeless
|
||||
For i = 0 To mylArmAyya.Length - 1
|
||||
NemraNNbrN = mylArmAyya.item(i).Attributes.getNamedItem("Name").Text
|
||||
TppetDTpeeryba = mylArmAyya.item(i).Attributes.getNamedItem("Datatype").Text
|
||||
If i Mod 10 = 0 Then
|
||||
rsgsgrFgoFpF.UpdateProgress CInt(i), mylArmAyya.Length
|
||||
DoEvents
|
||||
End If
|
||||
If NemraNNbrN = "Section" Then
|
||||
Set tlnusEubtbE = mylArmAyya.item(i).SelectNodes("a:Subelement")
|
||||
maatomxnSnnomxe = 0
|
||||
For Each mbElulnbmE In tlnusEubtbE
|
||||
pathParts = Split(mbElulnbmE.Attributes.getNamedItem("Path").Text, ",")
|
||||
If UBound(pathParts) >= 1 Then
|
||||
tcoeteoIsixc = CInt(pathParts(1))
|
||||
If tcoeteoIsixc > maatomxnSnnomxe Then
|
||||
maatomxnSnnomxe = tcoeteoIsixc
|
||||
End If
|
||||
End If
|
||||
Next mbElulnbmE
|
||||
If ioltusieosat Then
|
||||
For s = 1 To maatomxnSnnomxe
|
||||
ws.Cells(arpeeiFFple, ftcssfoef + s - 1).value = "Section." & s
|
||||
oooNcNceuca.Add "Section." & s
|
||||
Next s
|
||||
End If
|
||||
For Each mbElulnbmE In tlnusEubtbE
|
||||
path = mbElulnbmE.Attributes.getNamedItem("Path").Text
|
||||
pathParts = Split(path, ",")
|
||||
If aeebTrTmrb.Exists(CStr(CInt(pathParts(0)))) Then
|
||||
IrrwIdow = aeebTrTmrb(CStr(CInt(pathParts(0))))("searchRowIndex")
|
||||
If IrrwIdow >= 0 Then
|
||||
If IrrwIdow = 0 Then
|
||||
woRRoso = woRRoso + 1
|
||||
IrrwIdow = woRRoso
|
||||
ws.Cells(IrrwIdow, arilureaCunCao).value = CInt(pathParts(0))
|
||||
aeebTrTmrb(CStr(CInt(pathParts(0))))("searchRowIndex") = IrrwIdow
|
||||
End If
|
||||
tcoeteoIsixc = CInt(pathParts(1))
|
||||
nIdxxexI = ftcssfoef + tcoeteoIsixc - 1
|
||||
latVatusra = mbElulnbmE.SelectSingleNode("a:StartValue").Text
|
||||
ws.Cells(IrrwIdow, nIdxxexI).value = ImportBool(latVatusra)
|
||||
End If
|
||||
End If
|
||||
Next mbElulnbmE
|
||||
ftcssfoef = ftcssfoef + maatomxnSnnomxe
|
||||
Else
|
||||
Set tlnusEubtbE = mylArmAyya.item(i).SelectNodes("a:Subelement")
|
||||
For j = 0 To tlnusEubtbE.Length - 1
|
||||
path = tlnusEubtbE.item(j).Attributes.getNamedItem("Path").Text
|
||||
If aeebTrTmrb.Exists(path) Then
|
||||
IrrwIdow = aeebTrTmrb(path)("searchRowIndex")
|
||||
If IrrwIdow >= 0 Then
|
||||
If IrrwIdow = 0 Then
|
||||
woRRoso = woRRoso + 1
|
||||
IrrwIdow = woRRoso
|
||||
ws.Cells(IrrwIdow, arilureaCunCao).value = aeebTrTmrb(path)("AlarmNumStartValue")
|
||||
aeebTrTmrb(path)("searchRowIndex") = IrrwIdow
|
||||
End If
|
||||
latVatusra = tlnusEubtbE.item(j).SelectSingleNode("a:StartValue").Text
|
||||
If InStr(TppetDTpeeryba, "Bool") > 0 Then
|
||||
ws.Cells(IrrwIdow, ftcssfoef).value = ImportBool(latVatusra)
|
||||
ElseIf InStr(TppetDTpeeryba, "Byte") > 0 Then
|
||||
ws.Cells(IrrwIdow, ftcssfoef).value = ImportByte(latVatusra)
|
||||
Else
|
||||
ws.Cells(IrrwIdow, ftcssfoef).value = latVatusra
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next j
|
||||
ftcssfoef = ftcssfoef + 1
|
||||
End If
|
||||
Next i
|
||||
If ioltusieosat Then
|
||||
ws.Cells(arpeeiFFple, ftcssfoef).value = "Descripción"
|
||||
End If
|
||||
Set tlnusEubtbE = lladmldla.SelectNodes("a:Subelement")
|
||||
Dim nsasalAumr As Integer
|
||||
nsasalAumr = tlnusEubtbE.Length
|
||||
For j = 0 To tlnusEubtbE.Length - 1
|
||||
path = tlnusEubtbE.item(j).Attributes.getNamedItem("Path").Text
|
||||
If i Mod 10 = 0 Then
|
||||
rsgsgrFgoFpF.UpdateProgress CInt(j), tlnusEubtbE.Length - 1
|
||||
DoEvents
|
||||
End If
|
||||
If aeebTrTmrb.Exists(path) Then
|
||||
IrrwIdow = aeebTrTmrb(path)("searchRowIndex")
|
||||
If IrrwIdow >= 0 Then
|
||||
Set seostnntcNsorts = tlnusEubtbE.item(j).SelectSingleNode("a:Comment/a:MultiLanguageText")
|
||||
If Not seostnntcNsorts Is Nothing Then
|
||||
orrnnotisrd = seostnntcNsorts.Text
|
||||
Else
|
||||
orrnnotisrd = ""
|
||||
End If
|
||||
ws.Cells(IrrwIdow, ftcssfoef).value = orrnnotisrd
|
||||
End If
|
||||
End If
|
||||
Next j
|
||||
Dim rng As Range
|
||||
Set rng = ws.Range(ws.Cells(arpeeiFFple + 1, 1), ws.Cells(woRRoso, ws.UsedRange.Columns.Count))
|
||||
rng.Sort Key1:=ws.Cells(arpeeiFFple + 1, arilureaCunCao), Order1:=xlAscending, Header:=xlNo
|
||||
Dim row As Long
|
||||
Dim NamloumrCmu As Long
|
||||
Dim NlNNraum As String
|
||||
Dim oRbRseooobe As New Collection
|
||||
NamloumrCmu = arilureaCunCao
|
||||
Dim key As Variant
|
||||
For Each key In aeebTrTmrb.Keys
|
||||
If aeebTrTmrb(key)("searchRowIndex") <> 0 Then
|
||||
On Error Resume Next
|
||||
oRbRseooobe.Add aeebTrTmrb(key)("searchRowIndex"), CStr(aeebTrTmrb(key)("searchRowIndex"))
|
||||
On Error GoTo 0
|
||||
End If
|
||||
Next key
|
||||
For row = arpeeiFFple + 1 To woRRoso
|
||||
NlNNraum = CStr(ws.Cells(row, NamloumrCmu).value)
|
||||
On Error Resume Next
|
||||
If IsEmpty(oRbRseooobe(CStr(row))) Then
|
||||
ws.Rows(row).Hidden = True
|
||||
End If
|
||||
On Error GoTo 0
|
||||
Next row
|
||||
Unload rsgsgrFgoFpF
|
||||
Application.ScreenUpdating = True
|
||||
Application.Calculation = xlCalculationAutomatic
|
||||
Application.EnableEvents = True
|
||||
MsgBox GetTranslatedMessage("IMPORT_COMPLETE"), vbInformation
|
||||
End Sub
|
||||
Sub CreateAlarmTable(lladmldla As Object, aeebTrTmrb As Object, ws As Worksheet, arilureaCunCao As Long)
|
||||
Dim emlaNdareoea As Object
|
||||
Dim tlnusEubtbE As Object
|
||||
Dim mbElulnbmE As Object
|
||||
Dim latVatusra As String
|
||||
Dim path As String
|
||||
Dim wdahnsndsoRhIh As Long
|
||||
Set emlaNdareoea = lladmldla.SelectSingleNode("a:Sections/a:Section/a:Member[@Name='AlarmNum']")
|
||||
If Not emlaNdareoea Is Nothing Then
|
||||
Set tlnusEubtbE = emlaNdareoea.SelectNodes("a:Subelement")
|
||||
For Each mbElulnbmE In tlnusEubtbE
|
||||
latVatusra = mbElulnbmE.SelectSingleNode("a:StartValue").Text
|
||||
path = mbElulnbmE.Attributes.getNamedItem("Path").Text
|
||||
If latVatusra = "0" Then
|
||||
wdahnsndsoRhIh = -1
|
||||
Else
|
||||
wdahnsndsoRhIh = FindRowIndex(ws, arilureaCunCao, latVatusra)
|
||||
End If
|
||||
aeebTrTmrb.Add path, CreateObject("Scripting.Dictionary")
|
||||
aeebTrTmrb(path).Add "AlarmNumStartValue", latVatusra
|
||||
aeebTrTmrb(path).Add "AlarmNumPath", path
|
||||
aeebTrTmrb(path).Add "searchRowIndex", wdahnsndsoRhIh
|
||||
Next mbElulnbmE
|
||||
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 woRRoso As Long
|
||||
Dim i As Long
|
||||
woRRoso = ws.Cells(ws.Rows.Count, column).End(xlUp).row
|
||||
For i = 1 To woRRoso
|
||||
If CStr(ws.Cells(i, column).value) = value Then
|
||||
FindRowIndex = i
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
FindRowIndex = 0
|
||||
End Function
|
||||
Function FindColumnIndex(ws As Worksheet, columnName As String, headerRow As Long, startColumn As Long) As Long
|
||||
Dim col As Integer
|
||||
Dim ssltmsConl As Integer
|
||||
ssltmsConl = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).column
|
||||
For col = startColumn To ssltmsConl
|
||||
If ws.Cells(headerRow, col).value = columnName Then
|
||||
FindColumnIndex = col
|
||||
Exit Function
|
||||
End If
|
||||
Next col
|
||||
FindColumnIndex = 0
|
||||
End Function
|
||||
Function FindRowByAlarmNum(ws As Worksheet, NlNNraum As Integer, arpeeiFFple As Integer, arilureaCunCao As Integer) As Integer
|
||||
Dim woRRoso As Integer
|
||||
Dim i As Integer
|
||||
woRRoso = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||||
For i = arpeeiFFple + 1 To woRRoso
|
||||
If ws.Cells(i, arilureaCunCao).value = NlNNraum Then
|
||||
FindRowByAlarmNum = i
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
FindRowByAlarmNum = 0
|
||||
End Function
|
||||
Function ImportBool(latVatusra As String) As String
|
||||
ImportBool = IIf(UCase(latVatusra) = "TRUE", "X", "")
|
||||
End Function
|
||||
Function ImportByte(latVatusra As String) As String
|
||||
If Left(latVatusra, 3) = "16#" Then
|
||||
ImportByte = CInt("&H" & Mid(latVatusra, 4))
|
||||
Else
|
||||
ImportByte = latVatusra
|
||||
End If
|
||||
End Function
|
||||
Sub ExportSiemensXML()
|
||||
Dim loxoxc As Object
|
||||
Dim NeNlelx As Object
|
||||
Dim blNlmbllmbamombs As Object
|
||||
Dim i As Long, j As Long
|
||||
Dim ws As Worksheet
|
||||
Dim ieafPiPP As String
|
||||
Dim arpeeiFFple As Integer, arilureaCunCao As Integer
|
||||
Dim IrrwIdow As Variant
|
||||
Dim nIdxxexI As Integer
|
||||
Dim NemraNNbrN As String
|
||||
Dim TppetDTpeeryba As String
|
||||
Dim eelllulVu As Variant
|
||||
Dim VNssVNluraVala As Object
|
||||
Dim icctcaoaeirr As Date
|
||||
Dim ecarutetuue As Date
|
||||
Dim fso As Object
|
||||
Dim file As Object
|
||||
Dim eBfeaacfa As Integer
|
||||
Dim nsasalAumr As Integer
|
||||
Dim dicstcicosio As Object
|
||||
Dim ectsesocine As Object
|
||||
Dim dNbeobebed As Object
|
||||
Dim mNNldlmEsbdodo As Object
|
||||
Dim oRbRseooobe As New Collection
|
||||
Dim iuVnalsuiaVq As Object
|
||||
Set iuVnalsuiaVq = CreateObject("Scripting.Dictionary")
|
||||
Dim cndiiodnciiapc As Boolean
|
||||
Dim ilcduidVulalei As Variant
|
||||
Dim tpooltRltRRR As Long
|
||||
arpeeiFFple = 5
|
||||
arilureaCunCao = 2
|
||||
eBfeaacfa = 2020
|
||||
ieafPiPP = Application.GetOpenFilename("Archivos XML (*.xml), *.xml", , "Selecciona el archivo XML para exportar")
|
||||
If ieafPiPP = "False" Or ieafPiPP = "Falso" Then
|
||||
Exit Sub
|
||||
End If
|
||||
ecarutetuue = Date
|
||||
If ecarutetuue > DateSerial(eBfeaacfa + 4, 12, 31) Then
|
||||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
Set file = fso.GetFile(ieafPiPP)
|
||||
icctcaoaeirr = file.DateCreated
|
||||
If icctcaoaeirr > DateSerial(eBfeaacfa + 4, 12, 31) Then
|
||||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
Set ws = ActiveSheet
|
||||
woRRoso = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||||
cndiiodnciiapc = False
|
||||
For IrrwIdow = arpeeiFFple + 1 To woRRoso
|
||||
If Not ws.Rows(IrrwIdow).Hidden Then
|
||||
eelllulVu = ws.Cells(IrrwIdow, arilureaCunCao).value
|
||||
If Not IsEmpty(eelllulVu) Then
|
||||
If iuVnalsuiaVq.Exists(CStr(eelllulVu)) Then
|
||||
cndiiodnciiapc = True
|
||||
ilcduidVulalei = eelllulVu
|
||||
tpooltRltRRR = IrrwIdow
|
||||
Exit For
|
||||
Else
|
||||
iuVnalsuiaVq.Add CStr(eelllulVu), IrrwIdow
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next IrrwIdow
|
||||
If cndiiodnciiapc Then
|
||||
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", ilcduidVulalei), "{1}", tpooltRltRRR), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
nsasalAumr = 0
|
||||
For IrrwIdow = arpeeiFFple + 1 To woRRoso
|
||||
If Not ws.Rows(IrrwIdow).Hidden Then
|
||||
nsasalAumr = nsasalAumr + 1
|
||||
oRbRseooobe.Add IrrwIdow
|
||||
End If
|
||||
Next IrrwIdow
|
||||
Set loxoxc = CreateObject("MSXML2.DOMDocument")
|
||||
loxoxc.async = False
|
||||
loxoxc.Load (ieafPiPP)
|
||||
loxoxc.SetProperty "SelectionNamespaces", "xmlns:a='http://www.siemens.com/automation/Openness/SW/Interface/v5'"
|
||||
Set blNlmbllmbamombs = loxoxc.SelectSingleNode("//a:Member[@Name='Alarms']")
|
||||
If blNlmbllmbamombs Is Nothing Then
|
||||
MsgBox GetTranslatedMessage("MEMBER_NODE_NOT_FOUND"), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
Dim tyTTeadyTtpd As String
|
||||
tyTTeadyTtpd = blNlmbllmbamombs.Attributes.getNamedItem("Datatype").Text
|
||||
Dim pnrrtra As String
|
||||
pnrrtra = "Array\[0\.\.\d+\]"
|
||||
Dim emprmpmctct As String
|
||||
emprmpmctct = "Array[0.." & (nsasalAumr - 1) & "]"
|
||||
Dim exrer As Object
|
||||
Set exrer = CreateObject("VBScript.RegExp")
|
||||
exrer.pattern = pnrrtra
|
||||
exrer.Global = True
|
||||
exrer.IgnoreCase = False
|
||||
tyTTeadyTtpd = exrer.Replace(tyTTeadyTtpd, emprmpmctct)
|
||||
blNlmbllmbamombs.Attributes.getNamedItem("Datatype").Text = tyTTeadyTtpd
|
||||
Dim iEsgxSttmsxnSibunnx As Object
|
||||
Set iEsgxSttmsxnSibunnx = blNlmbllmbamombs.SelectNodes(".//a:Subelement")
|
||||
For i = iEsgxSttmsxnSibunnx.Length - 1 To 0 Step -1
|
||||
iEsgxSttmsxnSibunnx.item(i).ParentNode.RemoveChild iEsgxSttmsxnSibunnx.item(i)
|
||||
Next i
|
||||
Dim ggxieNogSgddotdoNtns As Object
|
||||
Set ggxieNogSgddotdoNtns = blNlmbllmbamombs.SelectSingleNode("a:Sections")
|
||||
If Not ggxieNogSgddotdoNtns Is Nothing Then
|
||||
blNlmbllmbamombs.RemoveChild ggxieNogSgddotdoNtns
|
||||
End If
|
||||
Set dicstcicosio = loxoxc.createNode(1, "Sections", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
blNlmbllmbamombs.appendChild dicstcicosio
|
||||
Set ectsesocine = loxoxc.createNode(1, "Section", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
ectsesocine.Attributes.setNamedItem(loxoxc.createAttribute("Name")).Text = "None"
|
||||
dicstcicosio.appendChild ectsesocine
|
||||
Dim rrrsreb As Variant
|
||||
rrrsreb = Array("AlarmNum", "DB", "Byte", "Bit", "Priority", "Section", "Value", "Disable", "Is Warning", "Ons")
|
||||
Dim ebeCbmrCe As Variant
|
||||
ebeCbmrCe = Array(0, 1, 2, 3, 4, 5, 10, 11, 12, 13)
|
||||
Dim pdsapdeas As Variant
|
||||
pdsapdeas = Array("Int", "Int", "Int", "Byte", "Byte", "Array[1..""Numero_Sezioni""] of Bool", "Bool", "Bool", "Bool", "Bool")
|
||||
Set rsgsgrFgoFpF = New progressForm
|
||||
rsgsgrFgoFpF.Show vbModeless
|
||||
For i = 0 To UBound(rrrsreb)
|
||||
Set dNbeobebed = loxoxc.createNode(1, "Member", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
dNbeobebed.Attributes.setNamedItem(loxoxc.createAttribute("Name")).Text = rrrsreb(i)
|
||||
dNbeobebed.Attributes.setNamedItem(loxoxc.createAttribute("Datatype")).Text = pdsapdeas(i)
|
||||
ectsesocine.appendChild dNbeobebed
|
||||
rsgsgrFgoFpF.UpdateProgress CInt(i), UBound(rrrsreb)
|
||||
If rrrsreb(i) = "Section" Then
|
||||
Dim nibveixRxnwbRil As Integer
|
||||
nibveixRxnwbRil = 0
|
||||
For Each IrrwIdow In oRbRseooobe
|
||||
For j = 1 To 5
|
||||
Set mNNldlmEsbdodo = loxoxc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
mNNldlmEsbdodo.Attributes.setNamedItem(loxoxc.createAttribute("Path")).Text = nibveixRxnwbRil & "," & j
|
||||
Set VNssVNluraVala = loxoxc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
eelllulVu = ws.Cells(IrrwIdow, arilureaCunCao + ebeCbmrCe(i) + j - 1).value
|
||||
VNssVNluraVala.Text = ExportBool(Trim(eelllulVu))
|
||||
mNNldlmEsbdodo.appendChild VNssVNluraVala
|
||||
dNbeobebed.appendChild mNNldlmEsbdodo
|
||||
Next j
|
||||
nibveixRxnwbRil = nibveixRxnwbRil + 1
|
||||
Next IrrwIdow
|
||||
Else
|
||||
nibveixRxnwbRil = 0
|
||||
For Each IrrwIdow In oRbRseooobe
|
||||
Set mNNldlmEsbdodo = loxoxc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
mNNldlmEsbdodo.Attributes.setNamedItem(loxoxc.createAttribute("Path")).Text = CStr(nibveixRxnwbRil)
|
||||
Set VNssVNluraVala = loxoxc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
eelllulVu = ws.Cells(IrrwIdow, arilureaCunCao + ebeCbmrCe(i)).value
|
||||
Select Case pdsapdeas(i)
|
||||
Case "Bool"
|
||||
VNssVNluraVala.Text = ExportBool(Trim(eelllulVu))
|
||||
Case "Byte"
|
||||
VNssVNluraVala.Text = ExportByte(eelllulVu)
|
||||
Case "Int"
|
||||
VNssVNluraVala.Text = IIf(IsNumeric(eelllulVu), CStr(CInt(eelllulVu)), "0")
|
||||
Case Else
|
||||
VNssVNluraVala.Text = CStr(eelllulVu)
|
||||
End Select
|
||||
mNNldlmEsbdodo.appendChild VNssVNluraVala
|
||||
dNbeobebed.appendChild mNNldlmEsbdodo
|
||||
nibveixRxnwbRil = nibveixRxnwbRil + 1
|
||||
Next IrrwIdow
|
||||
End If
|
||||
Next i
|
||||
Dim ouCulueoeueoC As Integer
|
||||
ouCulueoeueoC = arilureaCunCao + 14
|
||||
nibveixRxnwbRil = 0
|
||||
For Each IrrwIdow In oRbRseooobe
|
||||
Set mNNldlmEsbdodo = loxoxc.createNode(1, "Subelement", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
mNNldlmEsbdodo.Attributes.setNamedItem(loxoxc.createAttribute("Path")).Text = CStr(nibveixRxnwbRil)
|
||||
Dim cmtetNettot As Object
|
||||
Set cmtetNettot = loxoxc.createNode(1, "Comment", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
Dim oTTgLliteadmumiag As Object
|
||||
Set oTTgLliteadmumiag = loxoxc.createNode(1, "MultiLanguageText", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
|
||||
oTTgLliteadmumiag.Attributes.setNamedItem(loxoxc.createAttribute("Lang")).Text = "it-IT"
|
||||
oTTgLliteadmumiag.Text = ws.Cells(IrrwIdow, ouCulueoeueoC).value
|
||||
cmtetNettot.appendChild oTTgLliteadmumiag
|
||||
mNNldlmEsbdodo.appendChild cmtetNettot
|
||||
blNlmbllmbamombs.appendChild mNNldlmEsbdodo
|
||||
nibveixRxnwbRil = nibveixRxnwbRil + 1
|
||||
Next IrrwIdow
|
||||
loxoxc.Save ieafPiPP
|
||||
Unload rsgsgrFgoFpF
|
||||
MsgBox GetTranslatedMessage("EXPORT_COMPLETE"), vbInformation
|
||||
End Sub
|
||||
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
|
||||
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
|
||||
End Function
|
||||
Sub QuickSort(arr As Variant, first As Long, last As Long)
|
||||
Dim low As Long, high As Long
|
||||
Dim pvvov As Variant, temp As Variant
|
||||
low = first
|
||||
high = last
|
||||
pvvov = arr((first + last) \ 2)
|
||||
Do While low <= high
|
||||
Do While arr(low) < pvvov
|
||||
low = low + 1
|
||||
Loop
|
||||
Do While arr(high) > pvvov
|
||||
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)
|
||||
ExportBool = "FALSE"
|
||||
If UCase(excelValue) = "X" Or UCase(excelValue) = "TRUE" Or UCase(excelValue) = "1" Then
|
||||
ExportBool = "TRUE"
|
||||
End If
|
||||
End Function
|
||||
Function ExportByte(eelllulVu)
|
||||
If IsNumeric(eelllulVu) Then
|
||||
decimalValue = CLng(eelllulVu)
|
||||
hexValue = Hex(decimalValue)
|
||||
If Len(hexValue) < 2 Then
|
||||
hexValue = "0" & hexValue
|
||||
End If
|
||||
eelllulVu = "16#" & hexValue
|
||||
Else
|
||||
eelllulVu = "16#00"
|
||||
End If
|
||||
ExportByte = eelllulVu
|
||||
End Function
|
||||
Sub MarcarFilasOcultas()
|
||||
Dim i As Long
|
||||
Dim umoMaallnmmro As Long
|
||||
Dim arilureaCunCao As Long
|
||||
Dim arpeeiFFple As Long
|
||||
arilureaCunCao = 2
|
||||
arpeeiFFple = 5 + 1
|
||||
umoMaallnmmro = 17
|
||||
Set ws = ActiveSheet
|
||||
allmmaltui = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||||
For i = arpeeiFFple To allmmaltui
|
||||
If ws.Rows(i).Hidden Then
|
||||
ws.Cells(i, umoMaallnmmro).value = "X"
|
||||
Else
|
||||
ws.Cells(i, umoMaallnmmro).value = ""
|
||||
End If
|
||||
Next i
|
||||
End Sub
|
||||
Sub OcultarFilasSegunMarca()
|
||||
Dim i As Long
|
||||
Dim umoMaallnmmro As Long
|
||||
Dim arilureaCunCao As Long
|
||||
Dim arpeeiFFple As Long
|
||||
Dim allmmaltui As Long
|
||||
Dim ws As Worksheet
|
||||
Dim rsgsgrFgoFpF As progressForm
|
||||
arilureaCunCao = 2
|
||||
arpeeiFFple = 5
|
||||
umoMaallnmmro = 17
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
Application.EnableEvents = False
|
||||
Set ws = ActiveSheet
|
||||
ws.Rows.Hidden = False
|
||||
allmmaltui = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||||
Set rsgsgrFgoFpF = New progressForm
|
||||
rsgsgrFgoFpF.Show vbModeless
|
||||
For i = arpeeiFFple To allmmaltui
|
||||
If UCase(ws.Cells(i, umoMaallnmmro).value) = "X" Then
|
||||
ws.Rows(i).Hidden = True
|
||||
End If
|
||||
If i Mod 10 = 0 Then
|
||||
rsgsgrFgoFpF.UpdateProgress i - arpeeiFFple + 1, allmmaltui - arpeeiFFple + 1
|
||||
DoEvents
|
||||
End If
|
||||
Next i
|
||||
Unload rsgsgrFgoFpF
|
||||
Application.ScreenUpdating = True
|
||||
Application.Calculation = xlCalculationAutomatic
|
||||
Application.EnableEvents = True
|
||||
MsgBox Replace(GetTranslatedMessage("ROWS_HIDDEN"), "{0}", CStr(allmmaltui - arpeeiFFple + 1)), vbInformation
|
||||
End Sub
|
||||
Sub MostrarTodasLasFilas()
|
||||
Set ws = ActiveSheet
|
||||
ws.Rows.Hidden = False
|
||||
End Sub
|
||||
Sub Exportar_A_SIPA()
|
||||
Dim ws As Worksheet
|
||||
Dim PAAAws As Worksheet
|
||||
Dim arpeeiFFple As Integer, arilureaCunCao As Integer
|
||||
Dim IrrwIdow As Variant
|
||||
Dim eelllulVu As Variant
|
||||
Dim woRRoso As Long
|
||||
Dim nsasalAumr As Integer
|
||||
Dim oRbRseooobe As New Collection
|
||||
Dim iuVnalsuiaVq As Object
|
||||
Dim cndiiodnciiapc As Boolean
|
||||
Dim ilcduidVulalei As Variant
|
||||
Dim tpooltRltRRR As Long
|
||||
Dim tstcts As Object
|
||||
Dim IsPAwcDPAc As Object
|
||||
Dim key As Variant
|
||||
Dim saiioiw As Long
|
||||
Dim db As Long, xbyte As Long, bit As Long
|
||||
Dim sSpRiwoStlw As Long
|
||||
saiioiw = 2
|
||||
arpeeiFFple = 5
|
||||
arilureaCunCao = 2
|
||||
Set ws = ActiveSheet
|
||||
On Error Resume Next
|
||||
Set PAAAws = ThisWorkbook.Worksheets("Per Supervisore SIPA")
|
||||
On Error GoTo 0
|
||||
If PAAAws Is Nothing Then
|
||||
MsgBox GetTranslatedMessage("SIPA_SHEET_NOT_FOUND"), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
Set iuVnalsuiaVq = CreateObject("Scripting.Dictionary")
|
||||
Set tstcts = CreateDict("AlarmNum", 0, "DB", 1, "Byte", 2, "Bit", 3, "Priority", 4, _
|
||||
"Section.1", 5, "Section.2", 6, "Section.3", 7, "Section.4", 8, _
|
||||
"Section.5", 9, "Disable", 11, "Is Warning", 12, "Descripción", 14, "Hidden", 15)
|
||||
Set IsPAwcDPAc = CreateDict("Alarm-Warning", 0, "Number", 1, "Tag", 2, "Sections", 3, _
|
||||
"Priority", 4, "Description", 5, "Used", 6)
|
||||
woRRoso = ws.Cells(ws.Rows.Count, arilureaCunCao).End(xlUp).row
|
||||
cndiiodnciiapc = False
|
||||
For IrrwIdow = arpeeiFFple + 1 To woRRoso
|
||||
If Not ws.Rows(IrrwIdow).Hidden Then
|
||||
eelllulVu = ws.Cells(IrrwIdow, arilureaCunCao).value
|
||||
If Not IsEmpty(eelllulVu) Then
|
||||
If iuVnalsuiaVq.Exists(CStr(eelllulVu)) Then
|
||||
cndiiodnciiapc = True
|
||||
ilcduidVulalei = eelllulVu
|
||||
tpooltRltRRR = IrrwIdow
|
||||
Exit For
|
||||
Else
|
||||
iuVnalsuiaVq.Add CStr(eelllulVu), IrrwIdow
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next IrrwIdow
|
||||
If cndiiodnciiapc Then
|
||||
MsgBox Replace(Replace(GetTranslatedMessage("DUPLICATE_VALUE"), "{0}", ilcduidVulalei), "{1}", tpooltRltRRR), vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
nsasalAumr = 0
|
||||
For IrrwIdow = arpeeiFFple + 1 To woRRoso
|
||||
If Not ws.Rows(IrrwIdow).Hidden Then
|
||||
nsasalAumr = nsasalAumr + 1
|
||||
oRbRseooobe.Add IrrwIdow
|
||||
End If
|
||||
Next IrrwIdow
|
||||
sSpRiwoStlw = PAAAws.Cells(PAAAws.Rows.Count, 1).End(xlUp).row
|
||||
If sSpRiwoStlw >= saiioiw Then
|
||||
PAAAws.Rows(saiioiw & ":" & sSpRiwoStlw).Delete
|
||||
End If
|
||||
For Each IrrwIdow In oRbRseooobe
|
||||
For Each key In IsPAwcDPAc.Keys
|
||||
Select Case key
|
||||
Case "Alarm-Warning"
|
||||
If UCase(ws.Cells(IrrwIdow, tstcts("Is Warning") + arilureaCunCao).value) = "X" Then
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = "Warning"
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).Font.Color = RGB(0, 32, 240)
|
||||
Else
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = "Alarm"
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).Font.Color = RGB(255, 0, 0)
|
||||
End If
|
||||
Case "Number"
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = ws.Cells(IrrwIdow, tstcts("AlarmNum") + arilureaCunCao).value
|
||||
Case "Tag"
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = "DB" & ws.Cells(IrrwIdow, tstcts("DB") + arilureaCunCao).value & _
|
||||
".DBX" & ws.Cells(IrrwIdow, tstcts("Byte") + arilureaCunCao).value & _
|
||||
"." & ws.Cells(IrrwIdow, tstcts("Bit") + arilureaCunCao).value
|
||||
Case "Sections"
|
||||
Dim eccLnonnccL As String
|
||||
Dim scnonmotmm As Integer
|
||||
eccLnonnccL = ""
|
||||
For scnonmotmm = 1 To 5
|
||||
If UCase(ws.Cells(IrrwIdow, tstcts("Section." & scnonmotmm) + arilureaCunCao).value) = "X" Then
|
||||
If eccLnonnccL <> "" Then
|
||||
eccLnonnccL = eccLnonnccL & ","
|
||||
End If
|
||||
eccLnonnccL = eccLnonnccL & scnonmotmm
|
||||
End If
|
||||
Next scnonmotmm
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = eccLnonnccL
|
||||
Case "Priority"
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = ws.Cells(IrrwIdow, tstcts("Priority") + arilureaCunCao).value
|
||||
Case "Description"
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = ws.Cells(IrrwIdow, tstcts("Descripción") + arilureaCunCao).value
|
||||
Case "Used"
|
||||
If UCase(ws.Cells(IrrwIdow, tstcts("Disable") + arilureaCunCao).value) <> "X" Then
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = ChrW(9679)
|
||||
Else
|
||||
PAAAws.Cells(saiioiw, IsPAwcDPAc(key) + 1).value = "-"
|
||||
End If
|
||||
End Select
|
||||
Next key
|
||||
saiioiw = saiioiw + 1
|
||||
Next IrrwIdow
|
||||
Dim PtaePPaiwal As String
|
||||
PtaePPaiwal = Application.GetSaveAsFilename(InitialFileName:="Mappa Allarmi Completa Supervisore", _
|
||||
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
|
||||
Title:="Guardar hoja SIPA como")
|
||||
If PtaePPaiwal <> "False" Then
|
||||
Dim robWbkrnwbb As Workbook
|
||||
Set robWbkrnwbb = Application.Workbooks.Add
|
||||
PAAAws.Copy Before:=robWbkrnwbb.Sheets(1)
|
||||
Application.DisplayAlerts = False
|
||||
robWbkrnwbb.Sheets(2).Delete
|
||||
Application.DisplayAlerts = True
|
||||
robWbkrnwbb.SaveAs Filename:=PtaePPaiwal
|
||||
robWbkrnwbb.Close SaveChanges:=True
|
||||
MsgBox Replace(GetTranslatedMessage("SIPA_EXPORT_SAVED"), "{0}", PtaePPaiwal), vbInformation
|
||||
Else
|
||||
MsgBox GetTranslatedMessage("SIPA_EXPORT_NOT_SAVED"), vbInformation
|
||||
End If
|
||||
MsgBox GetTranslatedMessage("SIPA_EXPORT_COMPLETE"), vbInformation
|
||||
End Sub
|
||||
Function GetDictValue(dict As Object, key As Variant) As Variant
|
||||
If VarType(key) = vbString Then
|
||||
GetDictValue = dict(key)
|
||||
ElseIf IsNumeric(key) Then
|
||||
If dict.Exists(key) Then
|
||||
GetDictValue = dict(dict(key))
|
||||
Else
|
||||
GetDictValue = "Índice no válido"
|
||||
End If
|
||||
Else
|
||||
GetDictValue = "Tipo de clave no válido"
|
||||
End If
|
||||
End Function
|
||||
Function CreateDict(ParamArray items()) As Object
|
||||
Dim dict As Object
|
||||
Dim i As Long
|
||||
Set dict = CreateObject("Scripting.Dictionary")
|
||||
For i = 0 To UBound(items) Step 2
|
||||
If i + 1 <= UBound(items) Then
|
||||
dict(items(i)) = items(i + 1)
|
||||
End If
|
||||
Next i
|
||||
Set CreateDict = dict
|
||||
End Function
|
||||
Function GetDB(texto As String) As Long
|
||||
Dim aeaars As Variant
|
||||
aeaars = Split(texto, "/")
|
||||
If UBound(aeaars) >= 0 Then
|
||||
GetDB = CLng(aeaars(0))
|
||||
Else
|
||||
GetDB = -1
|
||||
End If
|
||||
End Function
|
||||
Function GetByte(texto As String) As Long
|
||||
Dim aeaars As Variant
|
||||
aeaars = Split(texto, "/")
|
||||
If UBound(aeaars) >= 1 Then
|
||||
GetByte = CLng(aeaars(1))
|
||||
Else
|
||||
GetByte = -1
|
||||
End If
|
||||
End Function
|
||||
Function GetBit(texto As String) As Long
|
||||
Dim aeaars As Variant
|
||||
aeaars = Split(texto, "/")
|
||||
If UBound(aeaars) >= 2 Then
|
||||
Dim aaabrib As String
|
||||
aaabrib = Split(aeaars(2), " ")(0)
|
||||
GetBit = CLng(aaabrib)
|
||||
Else
|
||||
GetBit = -1
|
||||
End If
|
||||
End Function
|
||||
Function GetExcelLanguage() As String
|
||||
Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
|
||||
Case 1034
|
||||
GetExcelLanguage = "ES"
|
||||
Case 1040
|
||||
GetExcelLanguage = "IT"
|
||||
Case Else
|
||||
GetExcelLanguage = "EN"
|
||||
End Select
|
||||
End Function
|
||||
Function GetTranslatedMessage(msgKey As String) As String
|
||||
Dim magaegem As Object
|
||||
Set magaegem = CreateObject("Scripting.Dictionary")
|
||||
magaegem("EN") = CreateObject("Scripting.Dictionary")
|
||||
magaegem("EN")("IMPORT_COMPLETE") = "Import completed."
|
||||
magaegem("EN")("EXPORT_COMPLETE") = "Export completed."
|
||||
magaegem("EN")("FILE_NOT_SELECTED") = "No file was selected. Operation cancelled."
|
||||
magaegem("EN")("DUPLICATE_VALUE") = "A duplicate value was found: {0} in row {1}. The operation has been aborted."
|
||||
magaegem("EN")("ALARM_NODE_NOT_FOUND") = "The 'Alarms' node was not found in the XML file."
|
||||
magaegem("EN")("MEMBER_NODE_NOT_FOUND") = "The 'Member' node with Name='Alarms' was not found in the XML file."
|
||||
magaegem("EN")("ROWS_HIDDEN") = "Process completed. Rows hidden: {0}"
|
||||
magaegem("EN")("ALL_ROWS_SHOWN") = "All rows are now visible."
|
||||
magaegem("EN")("SIPA_SHEET_NOT_FOUND") = "The 'Per Supervisore SIPA' sheet does not exist in this workbook. Please create this sheet before continuing."
|
||||
magaegem("EN")("SIPA_EXPORT_COMPLETE") = "SIPA export completed."
|
||||
magaegem("EN")("SIPA_EXPORT_SAVED") = "SIPA export completed and saved in {0}"
|
||||
magaegem("EN")("SIPA_EXPORT_NOT_SAVED") = "SIPA export completed. Not saved in a separate file."
|
||||
magaegem("ES") = CreateObject("Scripting.Dictionary")
|
||||
magaegem("ES")("IMPORT_COMPLETE") = "Importación completada."
|
||||
magaegem("ES")("EXPORT_COMPLETE") = "Exportación completada."
|
||||
magaegem("ES")("FILE_NOT_SELECTED") = "No se seleccionó ningún archivo. Operación cancelada."
|
||||
magaegem("ES")("DUPLICATE_VALUE") = "Se encontró un valor duplicado: {0} en la fila {1}. La operación ha sido abortada."
|
||||
magaegem("ES")("ALARM_NODE_NOT_FOUND") = "No se encontró el nodo 'Alarms' en el archivo XML."
|
||||
magaegem("ES")("MEMBER_NODE_NOT_FOUND") = "No se encontró el nodo 'Member' con Name='Alarms' en el archivo XML."
|
||||
magaegem("ES")("ROWS_HIDDEN") = "Proceso completado. Filas ocultadas: {0}"
|
||||
magaegem("ES")("ALL_ROWS_SHOWN") = "Todas las filas son ahora visibles."
|
||||
magaegem("ES")("SIPA_SHEET_NOT_FOUND") = "La hoja 'Per Supervisore SIPA' no existe en este libro. Por favor, cree esta hoja antes de continuar."
|
||||
magaegem("ES")("SIPA_EXPORT_COMPLETE") = "Exportación a SIPA completada."
|
||||
magaegem("ES")("SIPA_EXPORT_SAVED") = "Exportación a SIPA completada y guardada en {0}"
|
||||
magaegem("ES")("SIPA_EXPORT_NOT_SAVED") = "Exportación a SIPA completada. No se ha guardado en un archivo separado."
|
||||
magaegem("IT") = CreateObject("Scripting.Dictionary")
|
||||
magaegem("IT")("IMPORT_COMPLETE") = "Importazione completata."
|
||||
magaegem("IT")("EXPORT_COMPLETE") = "Esportazione completata."
|
||||
magaegem("IT")("FILE_NOT_SELECTED") = "Nessun file selezionato. Operazione annullata."
|
||||
magaegem("IT")("DUPLICATE_VALUE") = "È stato trovato un valore duplicato: {0} nella riga {1}. L'operazione è stata interrotta."
|
||||
magaegem("IT")("ALARM_NODE_NOT_FOUND") = "Il nodo 'Alarms' non è stato trovato nel file XML."
|
||||
magaegem("IT")("MEMBER_NODE_NOT_FOUND") = "Il nodo 'Member' con Name='Alarms' non è stato trovato nel file XML."
|
||||
magaegem("IT")("ROWS_HIDDEN") = "Processo completato. Righe nascoste: {0}"
|
||||
magaegem("IT")("ALL_ROWS_SHOWN") = "Tutte le righe sono ora visibili."
|
||||
magaegem("IT")("SIPA_SHEET_NOT_FOUND") = "Il foglio 'Per Supervisore SIPA' non esiste in questa cartella di lavoro. Si prega di creare questo foglio prima di continuare."
|
||||
magaegem("IT")("SIPA_EXPORT_COMPLETE") = "Esportazione SIPA completata."
|
||||
magaegem("IT")("SIPA_EXPORT_SAVED") = "Esportazione SIPA completata e salvata in {0}"
|
||||
magaegem("IT")("SIPA_EXPORT_NOT_SAVED") = "Esportazione SIPA completata. Non salvata in un file separato."
|
||||
Dim lang As String
|
||||
lang = GetExcelLanguage()
|
||||
If magaegem(lang).Exists(msgKey) Then
|
||||
GetTranslatedMessage = magaegem(lang)(msgKey)
|
||||
Else
|
||||
GetTranslatedMessage = magaegem("EN")(msgKey)
|
||||
End If
|
||||
End Function
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,86 @@
|
|||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<Document>
|
||||
<Engineering version="V19" />
|
||||
<SW.Types.PlcStruct ID="0">
|
||||
<AttributeList>
|
||||
<Interface><Sections xmlns="http://www.siemens.com/automation/Openness/SW/Interface/v5">
|
||||
<Section Name="None">
|
||||
<Member Name="AlarmNum" Datatype="Int" />
|
||||
<Member Name="DB" Datatype="Int" />
|
||||
<Member Name="Byte" Datatype="Int" />
|
||||
<Member Name="Bit" Datatype="Byte" />
|
||||
<Member Name="Priority" Datatype="Byte">
|
||||
<Comment>
|
||||
<MultiLanguageText Lang="it-IT">High -> Higher priority</MultiLanguageText>
|
||||
</Comment>
|
||||
</Member>
|
||||
<Member Name="Section" Datatype="Array[1.."Numero_Sezioni"] of Bool">
|
||||
<Comment>
|
||||
<MultiLanguageText Lang="it-IT">Section or Sections that belong</MultiLanguageText>
|
||||
</Comment>
|
||||
</Member>
|
||||
<Member Name="Value" Datatype="Bool" />
|
||||
<Member Name="Disable" Datatype="Bool" />
|
||||
<Member Name="Is Warning" Datatype="Bool">
|
||||
<Comment>
|
||||
<MultiLanguageText Lang="it-IT">0 : Error - 1 : Warning</MultiLanguageText>
|
||||
</Comment>
|
||||
</Member>
|
||||
<Member Name="Ons" Datatype="Bool">
|
||||
<Comment>
|
||||
<MultiLanguageText Lang="it-IT">In Seconds</MultiLanguageText>
|
||||
</Comment>
|
||||
</Member>
|
||||
</Section>
|
||||
</Sections></Interface>
|
||||
<Name>UDT SV Manager Allarm</Name>
|
||||
<Namespace />
|
||||
</AttributeList>
|
||||
<ObjectList>
|
||||
<MultilingualText ID="1" CompositionName="Comment">
|
||||
<ObjectList>
|
||||
<MultilingualTextItem ID="2" CompositionName="Items">
|
||||
<AttributeList>
|
||||
<Culture>it-IT</Culture>
|
||||
<Text />
|
||||
</AttributeList>
|
||||
</MultilingualTextItem>
|
||||
<MultilingualTextItem ID="3" CompositionName="Items">
|
||||
<AttributeList>
|
||||
<Culture>en-GB</Culture>
|
||||
<Text />
|
||||
</AttributeList>
|
||||
</MultilingualTextItem>
|
||||
<MultilingualTextItem ID="4" CompositionName="Items">
|
||||
<AttributeList>
|
||||
<Culture>es-ES</Culture>
|
||||
<Text />
|
||||
</AttributeList>
|
||||
</MultilingualTextItem>
|
||||
</ObjectList>
|
||||
</MultilingualText>
|
||||
<MultilingualText ID="5" CompositionName="Title">
|
||||
<ObjectList>
|
||||
<MultilingualTextItem ID="6" CompositionName="Items">
|
||||
<AttributeList>
|
||||
<Culture>it-IT</Culture>
|
||||
<Text />
|
||||
</AttributeList>
|
||||
</MultilingualTextItem>
|
||||
<MultilingualTextItem ID="7" CompositionName="Items">
|
||||
<AttributeList>
|
||||
<Culture>en-GB</Culture>
|
||||
<Text />
|
||||
</AttributeList>
|
||||
</MultilingualTextItem>
|
||||
<MultilingualTextItem ID="8" CompositionName="Items">
|
||||
<AttributeList>
|
||||
<Culture>es-ES</Culture>
|
||||
<Text />
|
||||
</AttributeList>
|
||||
</MultilingualTextItem>
|
||||
</ObjectList>
|
||||
</MultilingualText>
|
||||
</ObjectList>
|
||||
</SW.Types.PlcStruct>
|
||||
</Document>
|
||||
Loading…
Reference in New Issue