從BASIC版本15到版本20的SPSS腳本

以下腳本是用'Winwrap basic'編寫的，它幾乎與VBA相同。我希望這個腳本能夠在SPSS 20上工作，該腳本在SPSS15上工作正常（通過將文件擴展名從STT更改爲TLO，因爲那是tablelook文件當時的情況）。從BASIC版本15到版本20的SPSS腳本

但是，無論何時我在SPSS 20中運行此腳本時，wwb處理器都會崩潰，並顯示一條通用錯誤消息'WWBProcessor遇到問題並需要關閉。對此造成的不便，我們表示歉意。'

該腳本有很好的評論，但腳本的目的是通過依次激活每個表並將表設置爲用戶指定的表，來改變輸出查看器窗口中每個表的tablelook內部列標籤，關閉表格並激活下一個表格。循環繼續，直到每個表已被設置爲新的tablelook和旋轉。

手動設置幾百張表的旋轉是艱鉅的，非常耗時，更不用說麻煩無聊了。這個腳本用於在15年後的幾秒鐘內完成這項任務，但是不斷變化的需求和對舊版本的支持不足，意味着我被迫使用更新的版本。

我很感激任何幫助。微型飛行器

Option Explicit 

Sub Main 
'BEGIN DESCRIPTION 
'This script changes all tabs to the same 'Tablelook' style. You will be prompted to choose the tablelook file. 
'END DESCRIPTION 
'****************** 
'Old description 
'This script assumes that objSpssApp ist the currently running 
'SPSS-Application and assigns every existing Pivot Table 
'in the Output Navigator a new TableLook which can be selected 
'from a Dialog box. Hidden tables will also be affected. 
'Originally Created by SPSS Germany. Author: Arnd Winter. 
'****************** 
'This script is written in the BASIC revision 'WinWrap Basic' code copied from VB or other basic languages may have to be modified to function properly. 

On Error GoTo Bye 

' Variable Declaration 
' For an undertermined reason scripts cannot be executed throught the Utilites -> Run scripts menu, 
' Instead they must be opened like a syntax file and ran from the SPSS 19 Scripting page. 
' Functionality on SPSS 20 is now completely gone, error message only reads 'WWB processor has encountered a problem and needs to close'. 
Dim objOutputDoc As ISpssOutputDoc 'Declares the Output variable 
Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc 'Assigns currently active output to Output variable 
Dim strAppPath As String 
Dim objOutputItems As ISpssItems 'variable defining every item in the current output window 
Dim objOutputItem As ISpssItem 'variable defining the current item 
Dim objPivotTable As PivotTable 
Dim intCount As Integer 'declare the variable that will store the number of instances 
Dim varStrLook As String 
Set objOutputItems=objOutputDoc.Items 
Dim i As Integer 'for loops we need an INT variable that will be counted against the number of instances 'i' is standard notation 
' Find out SPSS Directory 
strAppPath = objSpssApp.GetSPSSPath 

' Select TableLook 

'The Parametres you must enter into the GetFilePath() function are as follows: 
'(Optional)Firstly you enter the initial file name (if none is required use an asterisk * and the file extention, or *.*) 
'(Optional)The second part is the file extention expected, you can choose multiple filetypes if you seperate them with a semi-colon ; 
'(Optional)The third parametre is the directory where the file should be opened.(default - Current path) 
'The fourth parametre is the Title of the prompt, which should be enclosed in speech marks. 
'The Final parametre is the 'Option' 
'0 Only allow the user to select a file that exists. 
'1 Confirm creation when the user selects a file that does not exist. 
'2 Allow the user to select any file whether it exists or not. 
'3 Confirm overwrite when the user selects a file that exists. 
'+4 Selecting a different directory changes the application's current directory. 
'For more detailed information visit the WWB website. 
' http://www.winwrap.com/web/basic/language/?p=doc_getfilepath__func.htm 
varStrLook = GetFilePath$("*.stt","stt",strAppPath,"Select Tablelook and confirm with Save.",4) 
' Tested re-applying the dollar sign, cofusingly removing or adding the Dollar sign ($) 
' seems to have no effect. 

' If user presses Cancel or selected a file with the wrong file type then exit script 
If (Len(varStrLook)= 0) Or (Right(varStrLook,3)<>"stt") Then 
    Exit Sub 
End If 

' Loop which assigns a new TableLook to all existing Tables. 
intCount = objOutputItems.Count 'Assigns the total number of output items to the count-marker 
For i = 0 To intCount-1 'Start loop 
    Set objOutputItem=objOutputItems.GetItem(i) 'Get current item 
    If objOutputItem.SPSSType=SPSSPivot Then 'If the item is a pivot table then... 
     Set objPivotTable=objOutputItem.ActivateTable 'Activate the table for editing 
     objPivotTable.TableLook = varStrLook 'Apply the earlier selected table look. 
     objPivotTable.RotateColumnLabels=True 'Rotate collumn lables 
     objOutputItem.Deactivate 'Confirm changes and deactivate the table 
    End If 
Next 'End loop 
'******************************************************** 
'Updated script from Version 15 -> 
'Script now includes inner column label rotation 
'Script has been modified and adapted to improve performance 
'and to help people who wish to use/adapt the script 
'in future endeavours. 
'******************************************************** 
Bye: 
End Sub

來源

2013-03-20 Maverick Jones