'Solution ID: 100001561 'Version: O/S: WINDOWS 'Title: 'Setting Print options from a syntax file Description: 'Q. 'I am running an SPSS Syntax (Or Production Mode) job using SPSS Base For Windows. 'I would Like To be able To Set the Print options, but I can't seem to 'Do that without using a Dialog box. Is there Any way that I can Set '* Header '* Footer '* Orientation [ Portrait | Landscape ] '* Starting Page '* Space Between Items '* Chart Size [ AsIs | Full | Half | Quarter ] '* Paper Size [ Letter | Legal ] '* Print Range [ All | Selected ] 'from a syntax file? 'I would Like To be able To use different headers And footers For 'different portions of my syntax job. Is there Any way I can request 'a New document? 'Is there Any way I can Print the document from a syntax file? 'A. 'Yes there Is a way To Do this. 'It Is possible To control All Print options through Scripting, And To 'trigger a Script from a syntax job. What Is awkward Is passing 'information from the syntax job To the script. The script below uses 'one solution To the problem. The creator of the syntax file writes 'parameters As comments With special markers, Then triggers the script. 'The script parses the parameters out of the SPSS Log, Then makes the 'requested changes To the Print Options Dialog. The author of the 'syntax file should ensure that commands will be displayed In the Log. 'The safest way To Do this Is With Set PRINTBACK=LISTING. 'Within a block of comments (which Begin With asterisks), use @{ 'To mark the beginning of your parameters. Continue naming 'parameters And their values For As many comment lines As needed, 'being sure To Begin Each Line With an asterisk. Mark the End of 'the parameter block With }@. 'The parameter names are Not Case sensitive. The script will look 'at the first portion of most parameter names, so that "Space", '"SpaceB", Or "SpaceBetweenItems" will All match. Once a parameter 'Name has been located, the script will look For an equal sign, Then 'try To find a value To assign. It should never make an illegal 'assignment, As the script checks the values before changing the Print 'options. 'A syntax job which illustrates the use of the script And documents 'the available options follows immediately below. The script follows 'the syntax job; the two need To be saved into separate files As 'directed by the comments below. 'The script itself should be named "PrintOptions.SBS" In order For 'the syntax below To work unaltered. Use a fully-qualified path Name 'On the SCRIPT Command If the syntax And script file will be placed 'In different directories. '********************************************************************** '* Save this portion As a syntax (.sps) file. Begin here. '********************************************************************** '* PrintOptions script requires PrintBack = Listing. '* To be polite, save current settings before making the change. 'Preserve . 'Set printback=listing . '* Parameters For PrintOptions script: @{ '* Header="Your Favorite Header Here", '* Footer="Footer text here ... Page &[Page]", '* Orientation = landscape , '* StartPage=7 , '* NewDocument = True '* }@ . 'script "PrintOptions.sbs" . '* Note: &[Page] is the page number symbol. '* It will be replaced by the correct number On Each page, beginning With 'StartPage. '* Parameters For PrintOptions script, illustrating All parameters: @{ '* Header="Strings can even have 'Footer' (which is a parameter name) and 'quotes", '* Footer='Use single quotes around "double quotes" and vice versa '[&[Page]]', '* Orientation = landscape , [ Portrait | Landscape ] '* StartPage= 17 , [ any number ] '* SpaceBetweenItems = 24, [ any number ] '* ChartSize = AsIs, [ AsIs | Full | Half | Quarter ] '* PaperSize = Letter, [ Letter | Legal ] '* PrintRange = All, [ All | Selected ] '* PrintDocument = False, [ True | False ] '* NewDocument = False, [ True | False ] '* }@ . 'script "PrintOptions.sbs" . '* Restore the options saved by the Preserve Command . 'restore . '********************************************************************** '* Save this portion As a syntax (.sps) file. End here. '********************************************************************** '********************************************************************** 'Save the following to a script named "PrintOptions.SBS": '********************************************************************** Sub Main 'parameters are presumed to be in the log 'use a comment marked by "*@{" and ending with "}@" 'supply named parameters HEADER and FOOTER, in a syntax file ' *@{HEADER="Use this Header", FOOTER="and this footer. Page &[Page]" 'The starting page number can also be set with STARTPAGE ' and the ORIENTATION may be set to PORTRAIT or LANDSCAPE. 'Everything which can be controlled from the Print Options dialog ' can be set using this script. Dim strParams As String Dim strParam As String Dim Found As Variant Dim lngPage As Long Dim objDocument As ISpssOutputDoc Dim objPrintOpt As ISpssPrintOptions If objSpssApp.Documents.OutputDocCount > 0 Then Set objDocument = objSpssApp.GetDesignatedOutputDoc Set objPrintOpt = objDocument.PrintOptions Else 'msgbox "Please open an output document " & _ ' "before running this script.", vbexclamation End End If strParams = GetParametersFromLog strParam = GetNamedParameter(strParams, "Header", "=") objPrintOpt.HeaderText = strParam 'no header by default, so setting it to an empty string hurts nothing strParam = GetNamedParameter (strParams, "Footer", "=", Found) 'don't clobber the default footer (Page &[Page]) if none specified If Found Then objPrintOpt.FooterText = strParam End If 'any portion of Orientation which includes Orient is acceptable strParam = GetNamedParameter (strParams, "Orient", "=", Found) If Found Then strParam = UCase$(Left$(strParam, 4)) If (InStr(1, strParam, "PORT") > 0) Then objPrintOpt.Orientation = 1 'Portrait ElseIf (InStr(1, strParam, "LAND") > 0) Then objPrintOpt.Orientation = 2 'Landscape End If End If strParam = GetNamedParameter (strParams, "StartPage", "=", Found) If Found Then lngValue = Val(strParam) If lngValue > 0 Then objPrintOpt.StartingPageNumber = lngValue End If End If 'any portion of SpaceBetweenItems which includes Space is acceptable strParam = GetNamedParameter (strParams, "Space", "=", Found) If Found Then lngValue = Val(strParam) If lngValue > 0 Then objPrintOpt.SpaceBetweenItems = lngValue End If End If strParam = GetNamedParameter (strParams, "ChartSize", "=", Found) If Found Then strParam = UCase$(Left$(strParam, 4)) If (InStr(1, strParam, "ASIS") > 0) Then objPrintOpt.PrintedChartSize = 0 'As is ElseIf (InStr(1, strParam, "FULL") > 0) Then objPrintOpt.PrintedChartSize = 1 'full page ElseIf (InStr(1, strParam, "HALF") > 0) Then objPrintOpt.PrintedChartSize = 2 'half page ElseIf (InStr(1, strParam, "QUAR") > 0) Then objPrintOpt.PrintedChartSize = 3 'quarter page End If End If strParam = GetNamedParameter (strParams, "PaperSize", "=", Found) If Found Then strParam = UCase$(strParam) If (InStr(1, strParam, "LETTER") > 0) Then objPrintOpt.PaperSize = 1 'Letter ElseIf (InStr(1, strParam, "LEGAL") > 0) Then objPrintOpt.PaperSize = 5 'Legal End If End If strParam = GetNamedParameter (strParams, "PrintRange", "=", Found) If Found Then strParam = UCase$(strParam) If (InStr(1, strParam, "ALL") > 0) Then objDocument.PrintRange(0) 'All Expanded Output ElseIf (InStr(1, strParam, "SELECT") > 0) Then objDocument.PrintRange(1) 'Selection End If End If strParam = GetNamedParameter (strParams, "PrintDoc", "=", Found) If Found Then If (InStr(1, UCase$(Left$(strParam, 4)), "TRUE") > 0) Then objDocument.PrintDoc End If End If strParam = GetNamedParameter (strParams, "NewDoc", "=", Found) If Found Then If (InStr(1, UCase$(Left$(strParam, 4)), "TRUE") > 0) Then objSpssApp.NewOutputDoc End If End If End Sub Function GetParametersFromLog() As String 'check for parameters in comments marked with @ Const PARAMS_BEGIN As String = "@{" Const PARAMS_END As String = "}@" Dim strLog As String Dim strParams As String Dim strToken As String strLog = GetLogText() strParams = strLog 'look In the Log For the last comment which begins With PARAMS_BEGIN: Do intLastPos = intPos intPos = InStr (intLastPos+1, strLog, PARAMS_BEGIN) Loop While intPos > 0 If intLastPos > 0 Then 'found a comment marked with the designator 'set up the parameter string strParams = Trim$(Mid$ (strLog, intLastPos)) 'discard the designator strParams = Trim$(Mid$ (strParams, Len(PARAMS_BEGIN)+1)) 'check for a final designator If Len(strParams) > 0 Then intPos = InStr(1, strParams, PARAMS_END) Else intPos = 0 End If 'discard final designator (and beyond), if present If intPos > 0 Then strParams = Trim$(Left$(strParams, intPos-1)) End If Else 'no parameters were found strParams = "" End If Debug.Print strParams GetParametersFromLog = strParams End Function Function GetNextToken(TokenString As String, Delimiter As String) As String Dim Position As Integer Position = InStr(UCase$(TokenString), UCase$(Delimiter)) If Position = 0 Then GetNextToken$ = Trim$(TokenString) TokenString = "" Else GetNextToken$ = Trim$(Left$(TokenString, Position - 1)) TokenString = Right$(TokenString, _ Len(TokenString) - Position - Len(Delimiter) + 1) End If End Function Function GetNextParam(TokenString As String) As String 'Look for something inside either double or single quotes ' or for Space or PARAM_DELIMITER as delimiter 'Function assumes blanks have been trimmed from both ends 'separate parameters with commas Const PARAM_DELIMITER As String = "," Dim Position As Integer Dim FirstChar As String FirstChar = Left$(LTrim$(TokenString), 1) Select Case FirstChar Case Chr$(34), "'" 'look for matching quote Position = InStr(2, TokenString, FirstChar) If Position > 0 Then GetNextParam = Mid$(TokenString, 2, Position - 2) TokenString = Mid$(TokenString, Position + 1) Else 'No matching token, error TokenString = "" GetNextParam = "" End If Case Else 'First char is not a quote, look for either 'PARAM_DELIMITER or space as delimiter Position = InStr(UCase$(TokenString), _ UCase$(PARAM_DELIMITER)) If Position = 0 Then Position = InStr(TokenString, " ") If Position = 0 Then 'whole thing must be the token GetNextParam = TokenString TokenString = "" Else GetNextParam = Mid$(TokenString, 1, Position) TokenString = Mid$(TokenString, _ Position + Len(PARAM_DELIMITER)) End If Else GetNextParam = Mid$(TokenString, 1, Position - 1) TokenString = Mid$(TokenString, _ Position + Len(PARAM_DELIMITER)) End If End Select End Function Function GetLogText() As String Dim objOutput As ISpssOutputDoc Dim objItems As ISpssItems Dim objitem As ISpssItem Dim objLog As ISpssrtf Dim strLog As String Dim lngCount As Long 'number of items in the navigator Dim i As Long 'for-loop index Set objOutput = objSpssApp.GetDesignatedOutputDoc Set objItems = objOutput.Items lngCount = objItems.Count 'find and activate the log For i = lngCount - 1 To 0 Step -1 Set objItem = objItems.GetItem(i) If objItem.SPSSType = SPSSLog Then Set objLog = objItem.ActivateText Exit For End If Next If objLog Is Nothing Then 'couldn't find the log GetLogText = "" Exit Function End If strLog = objLog.Text objItem.Deactivate 'Debug.Print "SPSS Log: " & vbCrLf & strLog GetLogText = strLog End Function Function GetNamedParameter(ByVal strParams As String, _ ByVal strParamName As String, _ ByVal strDelimiter As String, _ Optional Found As Variant) As String 'searches for a parameter name, followed by the specified delimiter, 'and returns the parameter value after the delimiter Dim strParamsCopy As String Dim strParam As String Dim strToken As String Dim Position As Integer strParamsCopy = LTrim$(strParams) Do GetNextToken (strParamsCopy, strParamName) 'if the name wasn't found, the length will be zero Found = (Len(strParamsCopy) > 0) If Found Then 'enforce syntax rules: must be paired with delimiter, ' without intervening quotes, to be legal Position = InStr(1, strParamsCopy, strDelimiter) If Position > 0 Then 'make sure that it isn't part of a quoted string strToken = Left$(strParamsCopy, Position - 1) 'if quotes are between the parameter name 'and the delimiter, reject it Found = ((InStr(1, strToken, "'") = 0) And _ (InStr(1, strToken, Chr$(34)) = 0)) Else 'it wasn't paired with the delimiter, reject it Found = False End If End If If Found Then 'remove the portion preceding the delimiter strParamsCopy = Trim$(Right$(strParamsCopy, _ Len(strParamsCopy) - Position - Len(strDelimiter) + 1)) End If 'exit the loop when a name has been found 'or the parameters have been exhausted Loop Until Found Or (Len(strParamsCopy) = 0) 'now use GetNextParameter to find a 'quoted, space- or comma-delimited value strParam = Trim$(GetNextParam(strParamsCopy)) 'remove line breaks if present Position = InStr(1, strParam, vbCrLf) If Position > 1 Then strParam = Trim$(Left$(strParam, Position - 1)) End If Debug.Print "GetNamedParameter: " & strParam GetNamedParameter = strParam End Function '********************************************************************** 'Save the preceding to a script named "PrintOptions.SBS": '**********************************************************************