Alex_Piggy
Advanced Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Код:
Option Explicit
Const cChanNum = 1
Const cChanName = 2
Const cRtuNum = 3
Const cRtuName = 4
Const cStatuses = 5
Const cStatName = 6
Const cStatTMS = 7
Const cStatDelta = 8
Const cTU = 9
Const cStatClass = 10
Const cStatInv = 11
Const cStatLog = 12
Const cAPS = 13
Const cStatGrav = 14
Const cTwoBits = 15
Const cAnalogs = 16
Const cAnalogName = 17
Const cAnalogTMS = 18
Const cAnalogDelta = 19
Const cUnits = 20
Const cArrSize = 20
Public aData(), aDataPos
Load "D:\tms.cfg"
'Load "D:\example.xml"
Sub Load(vFileName)
Dim oChannel, oRTU, oNode, oStatus, oAnalog, oXML
Dim oRange
Dim aDataHeader, i
ReDim aData(cArrSize - 1, 0): aDataPos = LBound(aData)
aDataHeader = Array("№", "Канал", "№", "КП", "Группа ТС", "ТС имя", "ТС Адрес TMS", "ТС Адрес Delta", "адрес ТУ", "Класс ТС", "Инверсия", "Журнал нет", "АПС", "Важность", "2 бит", "Группа ТИ", "ТИ имя", "ТИ адрес TMS", "ТИ адрес Delta", "ТИ ед. изм")
For i = LBound(aData, 1) To UBound(aData, 1)
aData(i, 0) = aDataHeader(i)
Next
PushData
Set oXML = CreateObject("MSXML2.DomDocument.3.0")
oXML.Load vFileName
For Each oChannel In oXML.DocumentElement.SelectNodes("CHANNEL")
aData(cChanNum - 1, aDataPos) = oChannel.getAttribute("ChannelNum")
aData(cChanName - 1, aDataPos) = oChannel.getAttribute("ChannelName")
PushData
For Each oRTU In oChannel.SelectNodes("RTU")
aData(cRtuNum - 1, aDataPos) = oRTU.getAttribute("RTUNum")
aData(cRtuName - 1, aDataPos) = oRTU.getAttribute("RTUName")
PushData
For Each oNode In oRTU.SelectNodes("*")
Select Case oNode.BaseName
Case "STATUSES":
aData(cStatuses - 1, aDataPos) =IIF(oRTU.getAttribute("RTUObjPfx") <> "", oRTU.getAttribute("RTUName") & " ", "") & oNode.getAttribute("StaDesc")
PushData
For Each oStatus In oNode.SelectNodes("STATUS")
aData(cStatTMS - 1, aDataPos) = oStatus.getAttribute("StatusPoint")
aData(cStatName - 1, aDataPos) = oStatus.getAttribute("StatusName")
aData(cStatClass - 1, aDataPos) = oStatus.getAttribute("StatusClass")
aData(cStatInv - 1, aDataPos) = IIF(oStatus.getAttribute("StatusInvert") <> "", 1, "")
aData(cStatLog - 1, aDataPos) = IIF(oStatus.getAttribute("StatusRetro") <> "", 1, "")
aData(cAPS - 1, aDataPos) = IIF(oStatus.getAttribute("StatusSignal") <> "", 1, "")
Select Case oStatus.getAttribute("StatusImp")
Case "2 (сигнал)": aData(cStatGrav - 1, aDataPos) = 2
Case "3 (сирена)": aData(cStatGrav - 1, aDataPos) = 3
Case "0 (не записывать)": aData(cStatGrav - 1, aDataPos) = ""
Case Else: aData(cStatGrav - 1, aDataPos) = 1
End Select
PushData
Next
Case "ANALOGS":
aData(cAnalogs - 1, aDataPos) =IIF(oRTU.getAttribute("RTUObjPfx") <> "", oRTU.getAttribute("RTUName") & " ", "") & oNode.getAttribute("AnaDesc")
PushData
For Each oAnalog In oNode.SelectNodes("ANALOG")
aData(cAnalogTMS - 1, aDataPos) = oAnalog.getAttribute("AnalogPoint")
aData(cAnalogName - 1, aDataPos) = oAnalog.getAttribute("AnalogName")
aData(cUnits - 1, aDataPos) = oAnalog.getAttribute("AnalogUnits")
PushData
Next
End Select
Next
Next
Next
FillExcel
End Sub
Sub FillExcel()
' xlLineStyle enumeration (Excel) Specifies the line style for the border.
Const xlContinuous = 1 ' Continuous line.
Const xlDash = -4115 ' Dashed line.
Const xlDashDot = 4 ' Alternating dashes and dots.
Const xlDashDotDot = 5 ' Dash followed by two dots.
Const xlDot = -4118 ' Dotted line.
Const xlDouble = -4119 ' Double line.
Const xlLineStyleNone = -4142 ' No line.
Const xlSlantDashDot = 13 ' Slanted dashes.
' xlBordersIndex enumeration (Excel) Specifies the border to be retrieved.
Const xlDiagonalDown = 5 ' Border running from the upper left-hand corner to the lower right of each cell in the range.
Const xlDiagonalUp = 6 ' Border running from the lower left-hand corner to the upper right of each cell in the range.
Const xlEdgeBottom = 9 ' Border at the bottom of the range.
Const xlEdgeLeft = 7 ' Border at the left-hand edge of the range.
Const xlEdgeRight = 10 ' Border at the right-hand edge of the range.
Const xlEdgeTop = 8 ' Border at the top of the range.
Const xlInsideHorizontal = 12 ' Horizontal borders for all cells in the range except borders on the outside of the range.
Const xlInsideVertical = 11 ' Vertical borders for all the cells in the range except borders on the outside of the range.
Dim oExcel, oBook, oRange, vColumn, oColumn
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
Set oBook = oExcel.Workbooks.Add
Set oRange = oBook.Worksheets(1).Range("A1").Resize(UBound(aData, 2), cArrSize)
For Each vColumn in Array(cChanNum, cRtuNum)
With oRange.Columns(vColumn)
.ColumnWidth = 2.4
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With
Next
For Each vColumn in Array(cChanName, cRtuName)
oRange.Columns(vColumn).ColumnWidth = 12
Next
oRange.Rows(1).Borders(xlEdgeBottom).LineStyle = xlDouble
oRange.NumberFormat = "@"
oRange.Value2 = TransposeArray2D(aData)
End Sub
Sub PushData()
ReDim Preserve aData(cArrSize - 1, UBound(aData, 2) + 1)
aDataPos = aDataPos + 1
End Sub
Function IIF(exp, tru, fal)
If exp Then
IIF = tru
Else
IIF = fal
End If
End Function
Function TransposeArray2D(inArr)
Dim outArr(), i, j
ReDim outArr(UBound(inArr, 2), UBound(inArr, 1))
For i = UBound(inArr, 1) To LBound(inArr, 1) Step -1
For j = UBound(inArr, 2) To LBound(inArr, 2) Step -1
outArr(j, i) = inArr(i, j)
Next
Next
TransposeArray2D = outArr
End Function
|
|
