Главная / Программа

Анализ напряжений в Excel

Версия для печати

'макрос выводит напряжения по узлам схемы из Растра или Actopus в Эксель 
'с сортировкой по возрастанию
'Работа со скриптом:
'Загружаете в Растр(Actopus) схему ,напряжения которой необходимо 
'вывести для анализа в Эксель и запускаете скрипт.
'
'(С) Александров А. ОДУ Урала, 2003
'
' создаётся объект "Excel.Application" и переменной objEx присваивается ссылка на него
Set objEx = CreateObject("Excel.Application")
'в Экселе изменяется количество страниц в новой книге
objEx.SheetsInNewWorkbook = 1
'в Экселе создаётся новая книга, с числом страниц установленным ранее
objEx.Workbooks.Add
'Возвращается исходное число страниц в новой книге Экселя
objEx.SheetsInNewWorkbook = 3
'устанавливается имя первого Листа в Экселе
objEx.Worksheets(1).Name  = "data"

' ////////////////// основная программа вывода напряжения узлов в Эксель ///////////////////

' создаётся объект "node" и переменной tNode присваивается ссылка на него
  Set  tNode = Rastr.Tables("node")
' задётся вектор првоначальной привязки всего скрипта к таблице Экселя,
' в дальнейшем все функции ипользуют смещения относительно данного
' формат [смещение по строкам][смещение по столбцам]
  dVstart                   = Array(4,4)   'Y,X binding of Data Table
' задние заголовков для столбцовв порядке их вывода на экран 
  aHeaders                  = Array("номер узла","имя узла","отклонение dV%") 'Headers for columns
' задние загаловков столбцов Растр которые будут извлечены (соответсвуют заданным в Растре!!)
  aColHeaders               = Array("ny","name","otv")   ' headers of columns to be copy 
  
' функция копирующая в Эксель из Растра данные и расставляющая номера извлеченных записей
'dVstart(0) привязка выводимых данных по строкам Экселя
'dVstart(1) привязка выводимых данных по столбцам Экселя
'objEx ссылка на объект Эксель 
'tNode ссылка на таблицу Растра откуда копируются данные
'aColHeaders заголовки столбцов которые должны быть извлечены из Растра, из таблицы на 
'которую ссылается tNode
  CopyData dVstart(0),dVstart(1),objEx,tNode,aColHeaders
'функция создаёт заголовки данных
'dVstart(0) привязка выводимых данных по строкам Экселя
'dVstart(1) привязка выводимых данных по столбцам Экселя
'objEx ссылка на объект Эксель
'aHeaders заголовки
'"Отклонение напряжения от номинального по узлам в %" - непосредственное указание название всей таблицы
  CreateHeader dVstart(0),dVstart(1),objEx,aHeaders,"Отклонение напряжения от номинального по узлам в %"   
'функция сортировки данных в Экселе
'objEx.Worksheets("data") - передача ссылки на таблицу с данными для сортировки
'RangeA1(dVstart,0,1,3,tNode.Count) - задание диапазона сортируемых данных, с 
'помощью функции RangeA1 возвращающей диапазон ячеек Экселя в формате A2F4 (default)
'RangeA1(dVstart,3,1,3,1) - задание столбца по которому производится сортировка, 
'с помощью функции RangeA1 возвращающей диапазон ячеек Экселя в формате A2F4 (default)
  Sort objEx.Worksheets("data"),RangeA1(dVstart,0,1,3,tNode.Count),RangeA1(dVstart,3,1,3,1)

' задание с помощью функции RangeA1 диапазона значений Y для построения графика в Экселе
  RangeY =   RangeA1(dVstart,3,1,3,tNode.Count)
' задание с помощью функции RangeR1C1 диапазона значений X для построения графика в Экселе
' RangeR1C1 с помощью этой функции возвращающей диапазон ячеек Экселя в формате R1C1 Excell
' так как Эксель для построения график не принимает (default) формат диапазона
' поэтому для дипазона значений Х графика сделана специальная функция 
  RangeX = RangeR1C1(dVstart,2,1,2,tNode.Count)
  ' Range X values of Chart in format R1C1
'функция рисует график в Экселе
'RangeY, - диапазон значений Y для графика
'RangeX, - диапазон значений X для графика
'objEx, - ссылка на объект Эксель
' "Отклонение напряжения от номинального по узлам в %", - непосредственное задание названия графика
' "dV%" - задание сокращенного названия графика (выводится на вкладку графика и на ось Y)
  ChartGraph RangeY, RangeX, objEx, "Отклонение напряжения от номинального по узлам в %", "dV%" 
'///////////////////////////////End charting Z in Excell ///////////////////

' показать полученный результат 
objEx.Visible = true

'///////////////////////// End. of PROGRAM //////////////////////////////////
'////////////////////////////////////////////////////////////////////////////

'/////ЗДЕСЬ ИДУТ РЕАЛИЗАЦИИ ФУНКЦИЙ, КОТОРЫЕ БЫЛИ ИСПОЛЬЗОВАНЫ ВЫШЕ //////////
'//////////////////////// возвратить Диапазон ///////////////////////////////
'создание нормального Эксельного диапазона данных, на основе смещений от
' начальной привязки.
'aStart - начальная привязка программы, точка от которой считаются все смещения
'OffsetX, - столбец начала диапазона 
'OffsetY, - строка начала диапазона
'EndX, - столбец конца диапазона
'EndY - строка конца диапазона
Function RangeR1C1(aStart,OffsetX,OffsetY,EndX,EndY)
  'function create Excel Range in Format R1C1 Who now, that now
   RangeR1C1 = ("R"& (aStart(0)+OffsetY) &"C"& (aStart(1)+OffsetX) &":"&_
            "R"& (EndY+aStart(0)) &"C"& (aStart(1)+OffsetX))
End Function

'создание не нормального Эксельного диапазона данных,
' в формате (число столбцов,число строк) от начала листа
' на основе смещений от начальной привязки.
'aStart - начальная привязка программы, точка от которой считаются все смещения
'OffsetX, - столбец начала диапазона 
'OffsetY, - строка начала диапазона
'EndX, - столбец конца диапазона
'EndY - строка конца диапазона
Function RangeA1  (aStart,OffsetX,OffsetY,EndX,EndY)
  'function create Excell Range in format D34F45 (Excel Default)
   RangeA1   = (Chr(65+aStart(1)-1+OffsetX)& (aStart(0)+OffsetY) &":"&_
             Chr(65+aStart(1)-1+EndX)& (aStart(0)+EndY))
End Function
'///////////////////////End. Range Created //////////////////////////////////

'///////////////////////// Create Header Data table Sub /////////////////////
Sub CreateHeader(Ypoint,Xpoint,pObj,aHeaders,Header)
'Ypoint,Xpoint - начальна привязка программы,точка от которой считаются все смещения 
'pObj - указатель на объект Эксель 
'aHeaders - массив заголовков столбцов 
'Header - заголовок таблицы с данными

' присвоить tObjData ссылку на Экселевский лист с Данными
  Set tObjData = pObj.Worksheets("data")

' цикл перебирающий все заголовки и выводящий их на лист Экселя, с подгоном ширины столбцов под заголовки
  For i=LBound(aHeaders) to Ubound(aHeaders)
    tObjData.Cells(Ypoint  ,Xpoint+1+i).Value = aHeaders(i) ' присвоить заголовок Экселевскому столбцу
    tObjData.Columns(Xpoint+i+1).autoFit                    ' подгонка ширины столбца
  Next

  tObjData.Cells(Ypoint-2,Xpoint).Value = Header    'создание общего заголовка

End Sub




'///////////////////////////////////Copy Data sub /////////////////////////
Sub CopyData(Ypoint,Xpoint,pObj,pTable,aColHeaders)
' функия копирующая данные из Таблицы Растра в Эксель
'Ypoint,Xpoint - привязка выводимых данных к начальной точке 
'pObj - ссылка на объект Эксель
'pTable - ссылка на таблицу с данными в Растре
'aColHeaders - массив имён столбцов, которые должны быть извлечены из pTable

'получение ссылки на Экселевскую таблицу, куда будут выводится данные
  Set tObjData = pObj.Worksheets("data")

' цикл создающий номера выводимых записей
  For dCounter = Ypoint+1 To (pTable.Count+Ypoint)
  'cycle creating Numbers of rows
    tObjData.Cells(dCounter,dVstart(1)).Value = dCounter-dVstart(0)
  Next
' цикл извлечения данных из таблицы Растра
  For i=LBound(aColHeaders) to UBound(aColHeaders)
  ' cycle changing column for copy to Excell Sheet
      'цикл извлечения данных из отдельного столбца таблицы
      For dCounter = YPoint+1 To (pTable.Count+Ypoint)
      'cycle copying data from Rastr table.column to Excell.Sheets("data").column
      'копировать не масштабированные данные из таблицы Растра в Эксель
        tObjData.Cells(dCounter,Xpoint+i+1).Value = pTable.Cols(aColHeaders(i)).Z(dCounter-Ypoint-1)
      Next
  Next

End Sub


' //////////////////////////////// Charting sub ///////////////////
Sub ChartGraph(RangeY,RangeX,pObj,CTitle,YTitle)
'функция рисования графика в Экселе
  'получаем ссылку на таблицу с данными в Экселе
  Set tObjData = pObj.sheets("data")
  
  'делаем лист с данными активным, а то могут быть неприятности
  tObjData.Select
  'выделяем дипазон ячеек в Экселя для построения значений Y
  tObjData.Range(RangeY).Select
  'создаём новый график в Экселе , на основе выделенного диапазона ячеек
  'и присваиваем ссылку на него переменной pObjChart
  Set pObjChart                      = pObj.Charts.Add()
  ' задаём имя графику имя 
  pObjchart.Name = YTitle
  'задаём тип графика (гистограмма, столбцами и т.д.) 
  pObjChart.ChartType                = 51  'xlColumnClustered
  ' отключаем легенду графика
  pObjChart.HasLegend                = False
  'присваиваем имя серии данных графика по оси Y
  pObjChart.SeriesCollection(1).Name = CTitle

  With pObjChart
          .Axes(2, 1).HasTitle = True                    ' ось Y имеет заголовок
          .Axes(2, 1).AxisTitle.Characters.Text = YTitle 'устанавливаем заголовок
  End With

  With pObjChart.Axes(2)        'xlValue - работа с осью Y графика
        .MinimumScale = -15     'Max value axes Y - установление максимального значения по оси Y
        .MaximumScale =  15     'Min value axes Y - установление минимального значения по оси Y
        .MinorUnit = 1          'minor steep axes Y - шаг вспомогательной линии сетки 
        .MajorUnit = 5          'major steep axes Y - шаг основной линии сетки
        .Crosses = -4105        'xlAutomatic - автоматическое определение точки пересечение оси графика 
        .ReversePlotOrder = False ' не применять реверсирование к данным графика
  End With

  pObjChart.PlotArea.Interior.ColorIndex = -4105 ' - цвет области рисования графика белая(White)
  'добавление к диапазону значений Х ссылки на таблицу с данными
  RangeX = "=data!"& RangeX 
  ' задание графику диапазона значений Х
  pObjChart.SeriesCollection(1).XValues = RangeX
  ' откючение показа значений оси Х на графике (слишком много), их видно при наведении мыши !
  pObjChart.HasAxis(1,1)= False    'from Excell Chart.HasAxis(xlCategory, xlPrimary) = False

End Sub
'//////////////////////////////// End My Sub /////////////////////


'////////////////////////// sorting Sub //////////////////////////
Sub Sort(tData, RangeData, RangeBy)
'подпрограмма сортировки переданного диапазона
'RangeData - сортируемый диапазон
'RangeBy - столбец по которому производится сортировка

'используется функция стандартной сортировки Экселя
'в место пропущенных параметров ничего нет, за справкой в Эксель.
'можно добавить , что не выделять запятыми пропущенные параметры нельзя 
'пропускать параметры, те которые есть в Эксельском хелпе нельзя
' то есть вызов совпадает с вызовом на языках высокого уровня 

'Selection.Sort Key1:=Range("G5"), Order1:=xlAscending, Header:=xlGuess, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'xlAscending =1 , xlGuess = 0,xlTopToBottom = 1
'tData.Range("D4:G199").Sort tData.Range("G5"), 1, , , , , , 0,1, False, 1
' "D4:G199" "G5" 
tData.Range(RangeData).Sort tData.Range(RangeBy), 1, , , , , , 0,1, False, 1

End Sub
'///////////////// End. sorting Sub //////////////////////////////