Miguel
/
Excel.VBA.DB5100.Supervisore
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Terminada versione 0.4

This commit is contained in:
Miguel 2024-09-25 16:36:03 +02:00
parent 4ae4179b0f
commit 23319b8e0b
4 changed files with 139232 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139141
DB Supervisor Manager Master.xml Normal file
View File

File diff suppressed because it is too large Load Diff

96
DB Supervisor Manager.xml
View File

@ -1,96 +0,0 @@
<?xml version="1.0" encoding="utf-8"?>
<Document>
<Engineering version="V19" />
<SW.Blocks.GlobalDB ID="0">
<AttributeList>
<AutoNumber>false</AutoNumber>
<Interface><Sections xmlns="http://www.siemens.com/automation/Openness/SW/Interface/v5">
<Section Name="Static">
<Member Name="Allarms" Datatype="Array[0..2500] of &quot;UDT SV Manager Allarm&quot;">
<AttributeList>
<BooleanAttribute Name="SetPoint" SystemDefined="true">true</BooleanAttribute>
</AttributeList>
<Sections>
<Section Name="None" />
</Sections>
<Subelement Path="2482" />
<Subelement Path="2483" />
<Subelement Path="2484" />
<Subelement Path="2485" />
<Subelement Path="2486" />
<Subelement Path="2487" />
<Subelement Path="2488" />
<Subelement Path="2489" />
<Subelement Path="2490" />
<Subelement Path="2491" />
<Subelement Path="2492" />
<Subelement Path="2493" />
<Subelement Path="2494" />
<Subelement Path="2495" />
<Subelement Path="2496" />
<Subelement Path="2497" />
<Subelement Path="2498" />
<Subelement Path="2499" />
<Subelement Path="2500" />
</Member>
<Member Name="SECTIONS" Datatype="Array[1..&quot;Numero_Sezioni&quot;] of &quot;SIPA XDATA_Alarm_Sect_V04&quot;">
<AttributeList>
<BooleanAttribute Name="SetPoint" SystemDefined="true">true</BooleanAttribute>
</AttributeList>
</Member>
</Section>
</Sections></Interface>
<MemoryLayout>Standard</MemoryLayout>
<Name>DB Supervisor Manager</Name>
<Namespace />
<Number>5100</Number>
<ProgrammingLanguage>DB</ProgrammingLanguage>
</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.Blocks.GlobalDB>
</Document>

107
Funciones.bas
View File

@ -477,17 +477,6 @@ Sub ExportSiemensXML()
End If End If
Next rowIndex Next rowIndex
' Calcular el número de alarmas considerando solo las filas visibles
numAlarmas = 0
lastRow = ws.Cells(ws.Rows.Count, primeraColumna).End(xlUp).row
For rowIndex = primeraFila + 1 To lastRow
If Not ws.Rows(rowIndex).Hidden Then
numAlarmas = numAlarmas + 1
visibleRows.Add rowIndex
End If
Next rowIndex
' Cargar el archivo XML ' Cargar el archivo XML
Set xmlDoc = CreateObject("MSXML2.DOMDocument") Set xmlDoc = CreateObject("MSXML2.DOMDocument")
xmlDoc.async = False xmlDoc.async = False
@ -550,6 +539,9 @@ Sub ExportSiemensXML()
' Definir los miembros y sus tipos de datos ' Definir los miembros y sus tipos de datos
Dim members As Variant Dim members As Variant
members = Array("AlarmNum", "DB", "Byte", "Bit", "Priority", "Section", "Value", "Disable", "Is Warning", "Ons") 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 Dim dataTypes As Variant
dataTypes = Array("Int", "Int", "Int", "Byte", "Byte", "Array[1..""Numero_Sezioni""] of Bool", "Bool", "Bool", "Bool", "Bool") dataTypes = Array("Int", "Int", "Int", "Byte", "Byte", "Array[1..""Numero_Sezioni""] of Bool", "Bool", "Bool", "Bool", "Bool")
@ -571,8 +563,8 @@ Sub ExportSiemensXML()
subElementNode.Attributes.setNamedItem(xmlDoc.createAttribute("Path")).Text = visibleRowIndex & "," & j subElementNode.Attributes.setNamedItem(xmlDoc.createAttribute("Path")).Text = visibleRowIndex & "," & j
Set startValueNode = xmlDoc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5") Set startValueNode = xmlDoc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
cellValue = ws.Cells(rowIndex, primeraColumna + i + j - 1).value cellValue = ws.Cells(rowIndex, primeraColumna + memberCol(i) + j - 1).value
startValueNode.Text = IIf(UCase(Trim(cellValue)) = "X", "TRUE", "FALSE") startValueNode.Text = ExportBool(Trim(cellValue))
subElementNode.appendChild startValueNode subElementNode.appendChild startValueNode
memberNode.appendChild subElementNode memberNode.appendChild subElementNode
@ -587,11 +579,11 @@ Sub ExportSiemensXML()
subElementNode.Attributes.setNamedItem(xmlDoc.createAttribute("Path")).Text = CStr(visibleRowIndex) subElementNode.Attributes.setNamedItem(xmlDoc.createAttribute("Path")).Text = CStr(visibleRowIndex)
Set startValueNode = xmlDoc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5") Set startValueNode = xmlDoc.createNode(1, "StartValue", "http://www.siemens.com/automation/Openness/SW/Interface/v5")
cellValue = ws.Cells(rowIndex, primeraColumna + i).value cellValue = ws.Cells(rowIndex, primeraColumna + memberCol(i)).value
Select Case dataTypes(i) Select Case dataTypes(i)
Case "Bool" Case "Bool"
startValueNode.Text = IIf(UCase(Trim(cellValue)) = "X", "TRUE", "FALSE") startValueNode.Text = ExportBool(Trim(cellValue))
Case "Byte" Case "Byte"
startValueNode.Text = ExportByte(cellValue) startValueNode.Text = ExportByte(cellValue)
Case "Int" Case "Int"
@ -609,7 +601,7 @@ Sub ExportSiemensXML()
' Añadir los comentarios ' Añadir los comentarios
Dim commentColumn As Integer Dim commentColumn As Integer
commentColumn = ws.Cells(primeraFila, ws.Columns.Count).End(xlToLeft).column commentColumn = primeraColumna + 14
visibleRowIndex = 0 visibleRowIndex = 0
For Each rowIndex In visibleRows For Each rowIndex In visibleRows
@ -717,3 +709,86 @@ Function ExportByte(cellValue)
ExportByte = cellValue ExportByte = cellValue
End Function 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 = ThisWorkbook.Sheets(1)
' 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 = ThisWorkbook.Sheets(1)
' 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 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 = ThisWorkbook.Sheets(1)
' Mostrar todas las filas antes de comenzar la importación
ws.Rows.Hidden = False
End Sub

BIN
ImportExportDB5100 v0.3.xlsm
View File

Binary file not shown.