Правка текстового блока выдачи

 

Загрузить как .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
74
75
76
77
78
79
80
81
82
83
'Этот скрипт вызывается из файла синтаксиса "ExtractInfoFromTextOutput2.sps"
' См. описание назначения этого скрипта в указанном синтаксисе.
' http://www.spsstools.net

'********************************************************* 
'Сохраните следующий код в файле с именем "ExtractInfoFromTextOutput1.sbs"
' (и исправьте в соответствующем файле синтаксиса путь к этому скрипту).
'*********************************************************

' Перевод: А. Балабанов, 19.11.2008.
' Проверено: SPSS 10.0.7 (в современных версиях прилагаемый скрипт работать не будет, т.к. выдача
' команды SYSFILE INFO реализована не текстовым блоком, а мобильными таблицами - примеч. перев)

Option Explicit

Sub Main 

	Dim objOutput As ISpssOutputDoc 
	If objSpssApp.Documents.OutputDocCount > 0 Then 
		Set objOutput = objSpssApp.GetDesignatedOutputDoc 
		Else 
		MsgBox "Сначала необходимо выполнить команду SYSFILE INFO", vbExclamation
	End If 

	Call TrimInfoText(objOutput)  

End Sub 

'****************************
'  Сохраняем только текст между "File Type:" и "Variable Information:"
'
Sub TrimInfoText(objOutput As ISpssOutputDoc)
'****************************
	Dim objItems As ISpssItems 
	Dim objItem As ISpssItem 
	Dim objText As ISpssrtf 
	Dim strText As String 
	
	Dim lngCount As Long 	'число объектов выдачи в документе Навигатора (output)
	Dim i As Long 			'индексная переменная цикла
	On Error GoTo Oopps
	
	Set objItems = objOutput.Items 
	lngCount = objItems.Count 
	
	' Находим и активируем текстовый блок
	For i = lngCount - 1 To 0 Step -1 
		Set objItem = objItems.GetItem(i) 
		Debug.Print objItem.SPSSType
		If objItem.SPSSType = SPSSText Then 
			Set objText = objItem.ActivateText 
			Exit For 
		End If 
	Next 
	
	If objText Is Nothing Then 'невозможно найти текстовый блок
		MsgBox "Сначала необходимо выполнить команду SYSFILE INFO",vbExclamation
		Exit Sub 
	End If 

	' Чтение текстового блока
	strText = objText.Text
	
	' Удаление части текста, начиная со слов "Variable Information:"
	If InStr(strText,"Variable Information:")>1 Then
		strText = RTrim(Left(strText,InStr(strText,"Variable Information:")-1))
		Else
		MsgBox "Последний текстовый блок выдачи не является выдачей команды SYSFILE INFO!", vbCritical, "Error"
	End If
	' Удаление части текста до слов "File Type:", затем формируем текст, который запишем в текстовый блок
	strText = Mid(strText,InStr(strText,"File Type:"))
	objText.Text = strText
	objItem.Deactivate 
	Exit Sub
	
	Oopps:
	Select Case Err.Number
		Case Else
			Debug.Print "Ошибка №" & Err.Number & " " & Err.Description
			MsgBox "Произошла неожиданная ошибка. Скрипт завершает свою работу.", vbCritical
			Exit Sub
	End Select		
End Sub
Related pages

...

Navigate from here