Vba BASIC中从版本15到版本20的SPSS脚本

下面的脚本是用“Winwrap basic”编写的，它与VBA几乎相同。 我希望这个脚本能够在SPSS 20上运行，该脚本在SPSS15上运行良好（通过将文件扩展名从STT更改为TLO，因为当时的tablelook文件就是这样）

但是，每当我在SPSS 20中运行此脚本时，wwb处理器就会崩溃，并显示一条通用错误消息“wwb处理器遇到问题，需要关闭”。给您带来不便，我们深表歉意。”

脚本的注释很好，但脚本的目的是通过依次激活每个表并将表的外观设置为用户指定的外观、旋转内列标签、关闭表并激活下一个表，来更改输出查看器窗口中每个表的表外观。 循环将继续，直到每个表都设置为新的tablelook和rotation

手动设置几百张桌子的旋转是非常困难和耗时的，更不用说令人麻木的无聊了。在版本15中，这个脚本用于在几秒钟内完成这项任务，但是不断发展的需求和对旧版本的缺乏支持意味着我不得不使用新版本

如果有任何帮助，我将不胜感激。 微型飞行器

选项显式
副总管
“开始描述
'此脚本将所有选项卡更改为相同的“Tablelook”样式。系统将提示您选择tablelook文件。
"结束说明"
'******************
“旧的描述
'此脚本假定objSpssApp是当前正在运行的
'SPSS应用程序，并分配每个现有数据透视表
'在输出导航器中，可以选择一个新的TableLook
'从对话框中。隐藏表也将受到影响。
最初由德国SPSS创建。作者：阿恩德温特。
'******************
'此脚本使用基本版本'WinWrap BASIC'编写，从VB或其他基本语言复制的代码可能需要修改才能正常运行。
关于错误，再见
'变量声明
'由于不确定的原因，无法通过实用程序->运行脚本菜单执行脚本，
'相反，它们必须像语法文件一样打开，并从SPSS19脚本页面运行。
“SPSS 20上的功能现已完全消失，错误消息仅显示“WWB处理器遇到问题，需要关闭”。
Dim objOutputDoc As ISpssOutputDoc'声明输出变量
Set objOutputDoc=objSpssApp.getDesignedOutputdoc'将当前活动的输出分配给输出变量
将路径设置为字符串
Dim objOutputItems作为定义当前输出窗口中每个项目的ISpssItems变量
Dim objOutputItem作为定义当前项的ISpssItem变量
Dim objPivotTable作为数据透视表
Dim intCount As Integer'声明将存储实例数的变量
Dim varStrLook As字符串
设置objOutputItems=objOutputDoc.Items
Dim i As Integer’对于循环，我们需要一个INT变量，它将根据实例数‘i’进行计数，这是标准的表示法
'查找SPSS目录
StrapPath=objSpssApp.GetSPSSPath
'选择TableLook
'必须输入GetFilePath（）函数的参数如下：
'（可选）首先输入初始文件名（如果不需要，请使用星号*和文件扩展名，或**）
'（可选）第二部分是预期的文件扩展名，如果用分号分隔，可以选择多个文件类型；
'（可选）第三个参数是应该打开文件的目录。（默认-当前路径）
'第四个参数是提示的标题，应包含在语音标记中。
'最后一个参数是'Option'
“0仅允许用户选择存在的文件。
“1当用户选择不存在的文件时，确认创建。
'2允许用户选择任何文件，无论它是否存在。
“3当用户选择存在的文件时，确认覆盖。
“+4选择其他目录会更改应用程序的当前目录。
有关更多详细信息，请访问WWB网站。
' http://www.winwrap.com/web/basic/language/?p=doc_getfilepath__func.htm
varStrLook=GetFilePath$（“*.stt”、“stt”、strappath，“选择Tablelook并用Save确认”，4）
'重新应用美元符号，同时删除或添加美元符号（$）
“似乎没有效果。
'如果用户按“取消”或选择了错误文件类型的文件，则退出脚本
如果（Len（varStrLook）=0）或（Right（varStrLook，3）“stt”），则
出口接头
如果结束
'循环，为所有现有表指定新的TableLook。
intCount=objOutputItems.Count'将输出项目的总数指定给计数标记
对于i=0到intCount-1'的启动循环
设置objOutputItem=objOutputItems.GetItem（i）'获取当前项
如果objOutputItem.SPSSType=SPSSPivot，则“如果项目是透视表，则。。。
设置objPivotTable=objOutputItem.ActivateTable'激活表格进行编辑
objPivotTable.TableLook=varStrLook'应用先前选择的表外观。
objPivotTable.RotateColumnLabels=True“旋转标签”
objOutputItem.DEACTIVE“确认更改并停用表格
如果结束
下一个“结束循环”
'********************************************************
'从版本15更新的脚本->
'脚本现在包括内部列标签旋转
'已修改并调整脚本以提高性能
'并帮助希望使用/改编剧本的人
“在今后的努力中。
'********************************************************
再见：
端接头

首先要尝试的是将激活/停用呼叫替换为 GetTableOLEObject 这将更加高效，并且不需要透视表编辑器，但是您可以在激活的表上执行所有可以执行的操作

---

如果您没有针对V20的当前fixpack，fixpack2，那么安装它也是一个好主意。

首先要尝试的是将激活/停用调用替换为 GetTableOLEObject 这太多了

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