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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
'Код решения: 41959  Дата: 4 марта 2004 г.
'Продукт: SPSS   Версия:
'Краткая характеристика:  скрипт, меняющий цвет столбцов в интерактивном графике, если график
'не содержит группирующих переменных (имеется лишь одна переменная по оси X).
'Полная характеристика:  Использую SPSS для Windows. Имеется файл результатов, в котором есть
'сводные таблицы и интерактивные графики. Для каждой столбиковой диаграммы из интерактивных графиков,
'где отсутствуют группирующие переменные (есть лишь одна переменная по оси X), я хочу поменять
'цвет столбцов. Как это сделать автоматически?

'Краткая характеристика решения: вам должен помочь следующий скрипт
'Полная характеристика решения:
'Вам должен помочь следующий скрипт. Выделите скрипт, приведённый ниже и выберите меню Edit->Copy.
'Далее, меню File->New->Script. Нажмите "Отмена". Удалите весь текст в окне. Выберите меню Edit->Paste.
'Далее, меню File->Save As и сохраните скрипт, используя имя, вроде 'ПоменятьЦветСтолбцов.sbs'.
'Выйдите из окна скрипта.
'Убедитесь, что в окне результатов есть хотя бы один интерактивный график с единственной переменной по оси X.
'Выберите меню Utilities->Run Script. Найдите только что сохранённый скрипт. Выберите Run.
'Вы должны заметить, что у каждого интерактивного графика, содержащего единственную переменную по оси X,
'цвет столбцов сменился на зелёный. Графики же, которые содержат легенду (соответственно, например,
'столбцы разного цвета - примеч. перев.) не изменились.
'Посмотрите в конце скрипта, как можно задать желаемый цвет для столбцов.

'______________________________________________________________________________________

'Описание
'Скрипт пробегается по всем элементам в рабочем окне результатов.
'Каждый найденный интерактивный график скрипт проверяет на отсутствие в нём группирующих переменных.
'Затем скрипт меняет цвет столбцов на заданный.
'Конец описания

Option Explicit

Sub Main
	Dim objOutputDoc As ISpssOutputDoc
	Dim objOutputItems As ISpssItems
	Dim objOutputItem As ISpssItem
	Dim objSPSSIGraph As ISpssIGraph
	Dim objIgraph As ISpssIGraph
	Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc

	'Получаем ссылку на все элементы окна результатов и пробегаем по ним в поисках интерактивных графиков
	Set objOutputItems = objOutputDoc.Items()
	Dim intItemCount As Integer
	For intItemCount = 0 To objOutputItems.Count - 1
		Set objOutputItem = objOutputItems.GetItem(intItemCount)
		If objOutputItem.SPSSType = SPSSIGraph Then
			Set objIgraph = objOutputItem.Activate
			Set objIgraph = objOutputItem.GetIGraphOleObject
			Call ChangeBarColors (objIgraph)
			objOutputItem.Deactivate
		End If
	Next
End Sub

Sub ChangeBarColors (objIgraph As ISpssIGraph)
Dim I As Integer
Dim objBar As Variant 'в исходном коде - объект типа ISpssIGraphBarElement - примеч. перев.
Dim MyArea As ISpssIGraphArea
Dim objVariableManager As ISpssIGraphVariablesMgr
Set objVariableManager = objIgraph.VariablesMgr
	With objVariableManager
		For I = 0 To objIgraph.Elements.Count - 1
			'проверяем, нет ли в графике переменных-легенд, т.е. не присутствуют ли на графике элементы разного типа
			If .IsAssigned(3) = False And .IsAssigned(4)= False Then 'в исходном коде - вместо 3 и 4 - константы SpssIGraphColor и SpssIGraphStyle - примеч. перев.
				If objIgraph.Elements.Item(I).Type = 1 Then 'в исходном коде - вместо 1 - константа SpssIGraphBar - примеч. перев.
					Set objBar = objIgraph.Elements.Item(I)
					Set MyArea=objBar.GetArea
					With MyArea
						'здесь мы меняем цвет столбцов на зелёный
						'Для замены на нужный вам цвет
						'используйте перечень цветов с их кодами,
						'данный ниже.
						.BackgroundColor = RGB(0,255,0)
						'Коды цветов
						'За цветом следуют коды в формате RGB
						'Чёрный 0, 0, 0
						'Синий 0, 0, 255
						'Голубой 0, 255, 255
						'Зелёный 0, 255, 0
						'Ярко-красный 255, 0, 255
						'Красный 255, 0, 0
						'Белый 255, 255, 255
						'Жёлтый 255, 255, 0
					End With
				End If
				objIgraph.Redraw
			End If
		Next
	End With
End Sub