Поиск по меткам объектов в окне результатов

 

Загрузить как .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
'Поиск по меткам объектов в окне выдачи

'Begin Description
'Скрипт осуществляет поиск заданной строки в левой панели ("дереве" выдачи) окна результатов
'(поиск по так называемым "меткам" объектов выдачи). Поиск происходит без учёта регистра, совпадение фиксируется с любой частью метки.
'После нахождения метки скрипт выделяет объект с совпавшей меткой и запрашивает у пользователя:
'искать ли дальше другие объекты, или останавливаться.
'Условия: документ выдачи (output) должен быть открыт.
'Для удобства частого использования лучше "привязать" этот скрипт к кнопке на панели инструментов.
'End Description

'Автор: Raynald Levesque, 23.01.2003.
'http://www.spsstools.ru

'Перевод: А. Балабанов, 20.11.2008.
'Проверено: SPSS 15.0.0.

Option Explicit

Sub main
	Call SearchLabel()
End Sub


Sub SearchLabel()

	Dim objOutputDoc As ISpssOutputDoc
	Dim objOutputItems As ISpssItems
	Dim objOutputItem As ISpssItem
	Dim bolFound As Boolean
	Dim strTitle As String
	Dim cnt As Integer

	On Error GoTo Oopps
	bolFound = False

	' запрос строки поиска
	strTitle=UCase(InputBox("Введите метку","Поиск объекта выдачи с указанной меткой"))
	If Len(strTitle)=0 Then	Exit Sub

	' Установка ссылки та текущий документ выдачи и коллекцию объектов в нём
	Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
	Set objOutputItems = objOutputDoc.Items
	objOutputDoc.ClearSelection

	' Цикл по всем объектам
	For cnt = 0 To objOutputItems.Count - 1
		Set objOutputItem = objOutputItems.GetItem(cnt)
		Debug.Print objOutputItem.Label
		If InStr(UCase(objOutputItem.Label),strTitle) > 0 Then
			bolFound = True
			objOutputItem.Selected = True
			If Len(InputBox("Нажмите OK, если надо продолжить, 'Отмена', если надо остановиться","Продолжить поиск?","найден объект!")) =0 Then
				Exit Sub
			End If
			objOutputItem.Selected = False
		End If
	Next
	If bolFound =False Then
		MsgBox("Нет объектов с метками, содержащими: " & strTitle)
	Else
		MsgBox("Больше не найдено объектов с метками, содержащими: " & strTitle)
	End If
Exit Sub

Oopps:
	MsgBox Err.Number & " " & Err.Description	   'в случае ошибки: информируем об ошибке пользователя
	Debug.Print Err.Number & " " & Err.Description 'информация для отладки
	'Resume Next 'используем опцию игнорирования ошибок когда отлаживаем скрипт
End Sub
Related pages

...

Navigate from here