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
'Begin Description
'Цель: 		Переключение между книжной и альбомной ориентацией страницы печати выдачи.
'			Изменения действуют на всё содержимое текущего окна выдачи.
'Условия: 	нет (окно выдачи будет создано, если оно ещё не открыто)
'Входные параметры:		скрипт вызывается из синтаксиса с использованием следующего способа задания параметров:
'   	SCRIPT "c:\\your path\\PrintOrientation.sbs" ("1Верхний колонтитул") <----- книжная ориентация страницы
'   	SCRIPT "c:\\your path\\PrintOrientation.sbs" ("2Какой-то верхний колонтитул") <----- альбомная ориентация
'Автор:		Raynald Levesque, rlevesque@videotron.ca
'End Description

' Возможные будущие усовершенствования: при вызове скрипта применить ориентацию страницы, а затем создать новое текущее
' окно выдачи с книжной ориентацией (по умолчанию). И так далее: output1, output2...
' Когда скрипт будет вызван с параметром ("0") - послать на печать все окна выдачи. Последовательная
' нумерация страниц от одного окна выдачи к другому.

'Тема: Установка ориентации страницы и параметров колонтитула для печати выдачи (параметры передаются через синтаксис).
'Ключевые слова: печать, колонтитул, передача, параметры, синтаксис, скрипт, страница, ориентация.
'Опубликован: ?, перевод: 24.06.2008.
'Автор: Raynald Levesque, rlevesque@videotron.ca; перевод коммент.: А. Балабанов.
'Размещение: http://www.spsstools.ru/Scripts/Printing/PrintOrientation.txt (.sbs)
'Проверено: SPSS 15.0.0.

Option Explicit
Dim strHeader As String

Sub Main
Dim intOrient As Integer, StrErr As String
	'Обработка ошибки
	StrErr = "Входящий параметр должен быть равен 1 или 2:"
	On Error GoTo ErrLoad

	'Приём входящего параметра из синатксиса (код вызовет ошибку, если переданная строка не содержит число)
	strHeader = objSpssApp.ScriptParameter(0)
'	strHeader = "1My Title"
	intOrient = CInt(Mid(strHeader,1,1))
	If Len(strHeader) > 1 Then
		strHeader = Mid(strHeader,2)
		Else
		strHeader  = ""
	End If
	If intOrient <> 2 Then intOrient = 1	'установка по умолчанию на книжную ориентацию
	'Вызов процедуры для записи установок страницы
	PrintOrient(intOrient)
	Exit Sub
	
	ErrLoad:
	MsgBox StrErr & vbCr & Err.Description, vbExclamation, "Ошибка " & Err	'Отображение сообщения об ошибке пользователю
	Debug.Print StrErr & vbCr & "Ошибка " & Err		'Отображение сообщения об ошибке программисту
	Exit Sub

End Sub

Sub PrintOrient(intOrient As Integer)
	Dim objOutputDoc As ISpssOutputDoc
	Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
	With objOutputDoc.PrintOptions
		.HeaderText = strHeader
		.FooterText = "Послано на печать " & Date & " в " & Time & "    Стр. &[Page]"
		.StartingPageNumber = 1	
	End With
	objOutputDoc.PrintOptions.Orientation=intOrient
End Sub