Вставка сноски в каждую мобильную таблицу

 

Загрузить как .sbs Показать простым текстом

 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
'Begin Description
' Добавить сноску к каждой мобильной таблице в окне результатов.
' Автор: Raynald Levesque, 18.03.2004.
'End Description

' Перевод: А. Балабанов, 24.11.2008.
' Проверено: SPSS 15.0.1.1.
Option Explicit

' Измените следующую константу как следует (это и будет текстом сноски).
Const cFOOTNOTE="Взвешено по переменной weight1"

Sub Main
'Добавление одной и той же сноски ко всем мобильным таблицам.
Dim objOutputDoc As ISpssOutputDoc
Dim objOutputItems As ISpssItems
Dim objOutputItem As ISpssItem
Dim objPivotTable As PivotTable
Dim intCount As Integer
Dim IntItem As Integer

Dim I As Integer
	Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
	Set objOutputItems=objOutputDoc.Items
	' Цикл по всем мобильным таблицам
	For IntItem = 0 To objOutputItems.Count - 1
		Set objOutputItem = objOutputItems.GetItem (IntItem)
		If objOutputItem.SPSSType = SPSSPivot Then
		    Set objPivotTable = objOutputItem.ActivateTable
			Call InsertFootnote(objPivotTable,cFOOTNOTE)
		    objOutputItem.Deactivate
		End If
	Next IntItem
 End Sub



Sub InsertFootnote (objTable As PivotTable , strFootnote As String )
' Вставляет сноску в подвал текущей активированной мобильной таблицы
	Dim objDataCells As ISpssDataCells
	Dim objFootnotes As ISpssFootnotes

	Set objDataCells=objTable.DataCellArray
	Set objFootnotes=objTable.FootnotesArray

	objTable.UpdateScreen=False
	objDataCells.SelectCellAt (0,0)
	objTable.InsertFootnote(strFootnote)
	objTable.ClearSelection

	objFootnotes.ChangeMarkerToSpecial (0, " ")

	'Теперь выделяем область сносок для некоторых косметических изменений
	objTable.SelectAllFootnotes

	'Уменьшим размер шрифта против стандартного
	objTable.TextSize= 7

	'Выравнивание по левому краю
	objTable.HAlign=0
	'0 SpssHAlLeft (влево)
	'1 SpssHAlRight (вправо)
	'2 SpssHAlCenter (от центра)

	'Стиль шрифта
	objTable.TextStyle=0
	'0 SpssTSRegular (обычный)
	'1 SpssTSItalic (курсив)
	'2 SpssTSBold (полужирный)
	'3 SpssTSBoldItalic (полужирный курсив)

	objTable.UpdateScreen= True
End Sub
Related pages

...

Navigate from here