Установить число десятичных знаков для процентов

 

Загрузить как .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
'Заголовок:
'Установка числа десятичных знаков при отображении процентов сводных таблицах (Pivot Table)

'Описание:
'Вопрос.
'Допустим, я использую версию SPSS 7.5 и выше.
'Мне требуется устанавливать число десятичных знаков при выводе процентов в сводных таблицах.
'Есть возможность автоматизировать этот процесс?

'Ответ.
'Внизу приводится текст, который производит изменения в выделенной таблице.
'Процедура Sub Main может быть модифицирована. Однако, функция SetDecimalDigits вряд ли потребует
'изменений, независимо от того, будет ли она использоваться из ваших скриптов, или вызываться из
'процедуры Autoscript.
'Этот скрипт - модификация решения из AnswerNet, ID:  100007757
'Размещено в SPSSX-L 11.3.2003. Автор: Raynald Levesque

'Начало описания
'Функция SetDecimalDigits устанавливает формат ячейки для всех процентных значений с заданным
'числом десятичных знаков.
'Конец описания

Sub Main()
Dim objPivot As PivotTable
Dim objItem As ISpssItem
'Сводная таблица должна быть активирована
Dim bolFoundOutput As Boolean, bolFoundPivot As Boolean

GetFirstSelectedPivot objPivot, objItem, bolFoundOutput, bolFoundPivot
If Not (bolFoundOutput And bolFoundPivot) Then
Exit Sub
End If
'отложим перерисовку экрана пока не закончим преобразования
objPivot.UpdateScreen = False

'установим форматы всех ячеек в 2 знака после запятой
Call SetDecimalDigits(objPivot, 2)

objPivot.UpdateScreen = True
objItem.Deactivate
'иногда высота и ширина сводной таблицы подгоняется некорректно
'в таком случае повторная активация таблицы, как правило, помогает.
objItem.ActivateTable
objItem.Deactivate
End Sub


Sub SetDecimalDigits(objPivot As PivotTable, intDigits As Integer)
'Изменяем число десятичных знаков для всех ячеек, содержащих "%"
Dim lngRow As Long, lngCol As Long
Dim objDataCells As ISpssDataCells

Set objDataCells = objPivot.DataCellArray
	With objDataCells
		For lngRow = 0 To .NumRows - 1
			For lngCol = 0 To .NumColumns - 1
			If Not IsNull (.ValueAt (lngRow, lngCol)) Then
				If InStr(.NumericFormatAt(lngRow,lngCol),"%")>0 Then
					.HDecDigitsAt (lngRow, lngCol) = intDigits
				End If
			End If
			Next
		Next
	End With
objPivot.Autofit
End Sub
Related pages

...

Navigate from here