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