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
'Конвертирование синтаксиса в скрипт.
Option Explicit

Sub Main
' Данные скрипт конвертирует синтаксис из окна назначения синтаксиса (Designated Syntax Window)
' в формат скрипта. Результирующий скрипт вставляется в окно назначения синтаксиса, откуда
' был взят исходный код. При необходимости скрипт оттуда может быть вставлен пользователем
' в файл скрипта.

' Автор: Raynald Levesque, 13.07.2003.

	Dim objSyntaxDoc As ISpssSyntaxDoc
	Dim strLine As String
	Dim strSynCmd As String
	Dim intPos As Integer
	Dim strScript As String
	Set objSyntaxDoc=objSpssApp.GetDesignatedSyntaxDoc
	Debug.Clear
	Call test	'В эту пустую процедуру (см. ниже) вы можете вставить получившийся
	            'в результате предыдущего запуска скрипт и протестировать его.

	strSynCmd = objSyntaxDoc.Text & vbCrLf
	Debug.Print strSynCmd
	intPos = InStr(strSynCmd,vbCr)
	strScript = vbCrLf & "**** Синтаксис, указанный выше, представленный в виде скрипта." & vbCrLf & vbCrLf & _
		"Dim strCmd as string" & vbCrLf
	While intPos > 0	'необходимо заменить двойные кавычки одинарными, а также пропустить пустые строки
		strLine = Left(strSynCmd, intPos -1)
		Debug.Print Len(strLine)
		strSynCmd = Mid(strSynCmd, intPos + 1)
		intPos = InStr(strSynCmd, vbCr)
		If strLine<>"" Then strScript = strScript & "strCmd = strCmd & " & QuoteLine(strLine) & " & vbCrLf" & vbCrLf

	Wend
	Debug.Print strSynCmd
	objSyntaxDoc.Text = objSyntaxDoc.Text & strScript & vbCrLf & _
		"objSpssApp.ExecuteCommands (strCmd,False)"

End Sub

Sub test ()

End Sub

Function QuoteLine(strText As String) As String
	Const strDoubleQuote As String =Chr(34)
	Const strSingleQuote As String =Chr(39)
	strText=Replace$(strText,strDoubleQuote,strSingleQuote)
	QuoteLine = strDoubleQuote & strText & strDoubleQuote
End Function