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 |
|