'Begin Description 'Скрипт переносит статистику из таблицы Statistics блока выдачи команды Frequencies (частотный анализ) ' в сноски таблиц Frequencies для соответствующих переменных. 'Условия: Перед запуском скрипта пользователь должен выделить таблицу Statistics блока Frequencies. 'End Description 'НАЗНАЧЕНИЕ 'Извлечение некоторой информации из таблицы Frequencies Statistics и добавление её в качестве 'сноски в соответствующие таблицы Frequencies. 'УСЛОВИЯ 'Перед запуском скрипта в документе выдачи должна быть выделена таблица Statistics блока Frequencies. 'Соответствующие ей таблицы Frequencies должны располагаться немедленно за таблицей Statistics. 'Окно документа выдачи (Navigator, Output Document), который содержит выделенную таблицу, 'должно быть окном назначения (Designated Window). 'ЭФФЕКТ 'В каждую таблицу Frequencies блока Frequencies добавляется сноска с соответствующей данной переменной 'статистикой из таблицы Statistics. 'СОВЕТЫ 'Если вы - новичок в SPSS-программировании, щёлкните раздел Scripting Tips в меню 'Help. Так вы сможете получить первичную информацию по составлению и использованию скриптов. 'Для получения сведений об объектах SPSS, к которым можно получить доступ через скрипты, 'их свойствах и методах, нажмите F2. 'Для контекстной подсказки по синтаксису Sax Basic и объектам программирования SPSS, 'их свойствам и методам, подведите курсор к нужной части программного кода и нажмите F1. ' Поставляется с SPSS. ' Перевод: А. Балабанов, 18.11.2008 ' Проверено: SPSS 15.0.0. Все настройки скрипта сделаны в предположении, что выдача производится ' с английскими подписями таблиц и статистик (см. ниже) - примеч. перев. Public Const TABLENAME As String = "Statistics" Public Const VALID_ROW As String = "Valid" Public Const MISSING_ROW As String = "Missing" Public Const MEAN_ROW As String = "Mean" Public Const MEDIAN_ROW As String = "Median" Public Const MODE_ROW As String = "Mode" Public Const STDEV_ROW As String = "Std. Deviation" Public Const VARIANCE_ROW As String = "Variance" Public Const SKEWNESS_ROW As String = "Skewness" Public Const KURTOSIS_ROW As String = "Kurtosis" Public Const RANGE_ROW As String = "Range" Public Const MIN_ROW As String = "Minimum" Public Const MAX_ROW As String = "Maximum" Public Const SUM_ROW As String = "Sum" Public Const cWRONGSELECT As String = "Для работы скрипта необходимо, чтобы была выделена таблица Statistics блока выдачи Frequencies" Public Const cSELECTMSG As String = "Для работы скрипта необходимо," & vbCrLf & "чтобы вы выделили таблицу Statistics, в которой" & vbCrLf & "находится, как минимум, одна из следующих статистик: " Public Const cSCRIPTNAME As String = "Скрипт Frequencies Footnote" Option Explicit ''Все переменные перед использованием должны быть явно объявлены '*********************************************************************** Sub Main ''Объявление переменных Dim objItem As ISpssItem Dim objPivotTable As PivotTable Dim bolFoundOutputDoc As Boolean Dim bolPivotSelected As Boolean Call GetFirstSelectedPivot(objPivotTable,objItem, bolFoundOutputDoc, bolPivotSelected) If bolFoundOutputDoc And bolPivotSelected Then 'С вызова следующей процедуры собственно начинается извлечение и вставка статистики в сноски Call ExtractFrequenciesFootnote(objPivotTable, objItem) End If End Sub '********************************************************************** Sub ExtractFrequenciesFootnote(objPivotTable As PivotTable, objItem As ISpssItem) 'Назначение: извлечение статистики из таблицы Statistics блока таблиц Frequencies. 'Условия: Таблица Frequencies Statistics уже активирована ' Соответствующие таблицы Frequencies расположены непосредственно за таблицей Statistics 'Эффект: копирует статистики из таблицы Statistics (создаваемой после запуска команды Frequencies) 'Входные параметры: мобильная таблица Statistics 'Возвращаемые значения: нет 'Объявление переменных для специальных объектов SPSS Dim objDataCells As ISpssDataCells Dim objColLabels As ISpssLabels Dim objRowLabels As ISpssLabels Dim objPivMgr As ISpssPivotMgr Dim objDimension As ISpssDimension 'Объявление некоторых целочисленных индексных переменных Dim lngRowNum As Long Dim lngColNum As Long Dim lngNumCols As Long Dim lngNumRows As Long Dim lngScratchInteger As Long Dim lngNumberOfStatistics As Long Dim lngStatisticsRow(20) As Long Dim lngNumVars As Long Dim i As Integer 'Объявление строковых переменных Dim strHoldCells(255,255) As String Dim strHoldColLabels(255,255) As String Dim strHoldRowLabels(255,255) As String Dim strStatisticsLabel(20) As String Dim strFootNoteStrings(255) As String Dim strStatistics As String 'Объявление булевых переменных Dim bolFoundStatistic As Boolean 'Установим ссылки на нужные объекты SPSS Set objDataCells = objPivotTable.DataCellArray() Set objColLabels = objPivotTable.ColumnLabelArray() Set objRowLabels = objPivotTable.RowLabelArray() 'Инициализация переменной lngStatisticsRow lngNumberOfStatistics = 13 For lngScratchInteger = 1 To lngNumberOfStatistics lngStatisticsRow(lngScratchInteger) = 999 Next lngScratchInteger 'Инициализация переменной strStatisticsLabel 'Далее можно закомментировать часть статистик. Это определяет, какие статистики будут использоваться ' (извлекаться и включаться в сноски). 'Индексы соответствуют порядку появления статистик в таблице Statistics strStatisticsLabel(1) = VALID_ROW strStatisticsLabel(2) = MISSING_ROW strStatisticsLabel(3) = MEAN_ROW strStatisticsLabel(4) = MEDIAN_ROW strStatisticsLabel(5) = MODE_ROW strStatisticsLabel(6) = STDEV_ROW strStatisticsLabel(7) = VARIANCE_ROW strStatisticsLabel(8) = SKEWNESS_ROW strStatisticsLabel(9) = KURTOSIS_ROW strStatisticsLabel(10) = RANGE_ROW strStatisticsLabel(11) = MIN_ROW strStatisticsLabel(12) = MAX_ROW strStatisticsLabel(13) = SUM_ROW 'Проверка, выделена ли нужная таблица (нам нужна таблица с заголовком "Statistics") If objPivotTable.TitleText <> TABLENAME Then MsgBox cWRONGSELECT ,vbOkOnly, cSCRIPTNAME objItem.Deactivate Exit Sub End If lngNumCols = objRowLabels.NumColumns lngNumRows = objRowLabels.NumRows 'Извлечение подписей строк For lngRowNum = 0 To lngNumRows - 1 For lngColNum = 0 To lngNumCols - 1 If objRowLabels.ValueAt(lngRowNum,lngColNum) <> "" Then strHoldRowLabels(lngRowNum+1,lngColNum+1) = objRowLabels.ValueAt(lngRowNum,lngColNum) Else strHoldRowLabels(lngRowNum+1,lngColNum+1) = "." End If Next lngColNum Next lngRowNum bolFoundStatistic = False 'Анализ меток строк (массива strHoldRowLabels) 'Первое совпадение с ключевым словом из массива (strStatisticsLabel) указывает, что строка содержит очередную статистику. 'Запоминаем для этой статистики номер строки (в массиве lngStatisticsRow) For lngRowNum = 0 To lngNumRows - 1 For lngColNum = 0 To lngNumCols - 1 For lngScratchInteger = 1 To lngNumberOfStatistics If lngStatisticsRow(lngScratchInteger) = 999 Then If strHoldRowLabels(lngRowNum+1,lngColNum+1) = strStatisticsLabel(lngScratchInteger) Then lngStatisticsRow(lngScratchInteger) = lngRowNum bolFoundStatistic = True End If End If Next lngScratchInteger Next lngColNum Next lngRowNum If bolFoundStatistic = False Then 'Если в подписях строк не найдено ни одной статистики, возможно, это признак того, что выделена не та таблица For i = 1 To lngNumberOfStatistics strStatistics = strStatistics & "- " & strStatisticsLabel(i) & vbCrLf Next i MsgBox cSELECTMSG & vbCrLf & vbCrLf & strStatistics,vbOkOnly, cSCRIPTNAME objItem.Deactivate Exit Sub End If Set objPivMgr = objPivotTable.PivotManager If objPivMgr.NumLayerDimensions = 0 Then 'имена переменных находятся в колонках lngNumCols = objColLabels.NumColumns lngNumRows = objColLabels.NumRows 'Извлечение меток колонок For lngRowNum = 0 To lngNumRows - 1 For lngColNum = 0 To lngNumCols - 1 If objColLabels.ValueAt(lngRowNum,lngColNum)<>"" Then strHoldColLabels(lngRowNum+1,lngColNum+1) = objColLabels.ValueAt(lngRowNum,lngColNum) Else strHoldColLabels(lngRowNum+1,lngColNum+1) = "." End If Next lngColNum Next lngRowNum lngNumVars = lngNumCols Else 'имена переменных находятся в слоях Set objDimension = objPivMgr.LayerDimension(0) lngNumCols = objDimension.NumCategories 'Извлечение меток слоев For lngColNum = 0 To lngNumCols - 1 objDimension.CurrentCategory = lngColNum strHoldColLabels(2, lngColNum+1) = objDimension.CategoryValueAt(lngColNum) Next lngColNum lngNumVars = lngNumCols End If lngNumCols = objDataCells.NumColumns lngNumRows = objDataCells.NumRows 'Извлечение значений из ячеек (извлечение статистик) ' и создание (конкатенация) строк, которые будут помещены в сноски For lngColNum = 0 To lngNumCols - 1 For lngRowNum = 0 To lngNumRows - 1 If objDataCells.ValueAt(lngRowNum,lngColNum)<>"" Then strHoldCells(lngRowNum+1,lngColNum+1) = objDataCells.ValueAt(lngRowNum,lngColNum) Else strHoldCells(lngRowNum+1,lngColNum+1) = "." End If If strHoldCells(lngRowNum+1,lngColNum+1) <> "." Then For lngScratchInteger = 1 To lngNumberOfStatistics If lngRowNum = lngStatisticsRow(lngScratchInteger) Then If InStr(strHoldCells(lngRowNum+1,lngColNum+1), ".") Then strFootNoteStrings(lngColNum) = strFootNoteStrings(lngColNum) + strStatisticsLabel(lngScratchInteger) + " = " + Format(strHoldCells(lngRowNum+1,lngColNum+1),"###.##") + " " Else strFootNoteStrings(lngColNum) = strFootNoteStrings(lngColNum) + strStatisticsLabel(lngScratchInteger) + " = " + strHoldCells(lngRowNum+1,lngColNum+1) + " " End If End If Next lngScratchInteger End If Next lngRowNum Next lngColNum objItem.Deactivate 'Процедура InsertFootnotes вставляет извлеченные статистики в сноски частотных таблиц 'для соответствующих переменных. Call InsertFootnotes(lngNumVars, strFootNoteStrings(), strHoldColLabels()) End Sub '******************************************************************* Sub InsertFootnotes(lngNumVars As Long, strFootNotes() As String, strHoldColLabels() As String) 'Назначение: вставка статистики в качестве сносок в таблицы Frequencies (частотные таблицы). 'Условия: сноски готовы к вставке: статистика извлечена из таблицы Statistics процедурой ExtractFrequenciesFootnote 'Эффект: вставка сносок в таблицы Frequencies 'Входные параметры: число переменных (lngNumVars), сноски для вставки (strFootNotes), имена переменных (strHoldRowLabels) 'Возвращаемые значения: нет Dim objOutputDoc As ISpssOutputDoc Dim objItems As ISpssItems Dim objItem As ISpssItem Dim objPivotTable As PivotTable Dim lngStartIndex As Long Dim lngIndex As Long Dim lngAddItems As Long Dim i As Long 'Инициализация (установка ссылок) объектов верхних уровней Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc Set objItems = objOutputDoc.Items For i = 0 To objItems.Count() Set objItem = objItems.GetItem(i) If objItem.Selected = True Then lngStartIndex = i Exit For End If Next i 'Пробегаем по таблицам, следующим за таблицей Statistics, из которой взяли статистику для вставки. '(на глубину, соответствующую количеству найденных переменных) 'Если заголовок таблицы соответствует имени очередной переменной, вставляем в неё соответствующую ссылку lngAddItems = 0 If lngNumVars <> 1 Then lngAddItems = 3 Else lngAddItems = 1 End If lngStartIndex = lngStartIndex + lngAddItems For i = lngStartIndex To lngStartIndex + lngNumVars - 1 Set objItem = objItems.GetItem(i) If objItem.SPSSType = SPSSPivot Then Set objPivotTable = objItem.Activate objPivotTable.SelectTitle For lngIndex = 0 To lngNumVars-1 If strHoldColLabels(2, lngIndex+1) = objPivotTable.TitleText Then objPivotTable.InsertFootnote(strFootNotes(lngIndex)) End If Next lngIndex objItem.Deactivate End If Next i End Sub