1

以下のスクリプトは、VBAとほぼ同じ「Winwrapbasic」で記述されています。このスクリプトをSPSS20で動作させたいのですが、スクリプトはSPSS15で正常に動作します（ファイル拡張子をSTTからTLOに変更することにより、当時のtablelookファイルでした）。

ただし、このスクリプトをSPSS 20で実行すると、wwbプロセッサがクラッシュして一般的なエラーメッセージが表示されます。'WWBProcessorで問題が発生したため、閉じる必要があります。ご不便をおかけしてしまい申し訳ございません。'

スクリプトには十分なコメントがありますが、スクリプトの目的は、各テーブルを順番にアクティブにし、ユーザーが指定したテーブルルックに設定し、内側の列ラベルを回転させることにより、出力ビューアウィンドウのすべてのテーブルのテーブルルックを変更することです。テーブルを閉じて、次のテーブルをアクティブにします。ループは、すべてのテーブルが新しいテーブルルックと回転に設定されるまで続きます。

数百のテーブルの回転を手動で設定することは、面倒で退屈なことは言うまでもなく、骨の折れる作業であり、非常に時間がかかります。このスクリプトは、バージョン15で数秒前にこのタスクを実行するために使用されていましたが、常に進化するニーズと古いバージョンのサポートの欠如により、新しいバージョンを使用せざるを得なくなりました。

どんな援助にも感謝します。Mav

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
4

1 に答える 1

1

最初に試すことは、アクティブ化/非アクティブ化の呼び出しをGetTableOLEObjectに置き換えることです。これははるかに効率的で、ピボットテーブルエディターを必要としませんが、アクティブ化されたテーブルで実行できるすべてのことを実行できます。

V20用の現在のフィックスパックfixpack2がない場合は、それをインストールすることもお勧めします。

于 2013-03-21T01:52:51.243 に答える