'Begin Description 'This script replaces words contained in the title, footnotes, and label cells 'of pivot tables. It provides a dialog box in which the user specifies the 'word to search for together with the word that replaces it. 'It is possible to replace more than one word at a time, by specifying in the 'Dialog box a list of word replacements. 'That list can be saved into a file, which can be loaded later for reuse. 'A check box on the form allows the user to choose if the search for the word to 'be replaced is case sensitive (distinguishing uppercase/lowercase letters or not). 'The user can also choose what part of tables to replace '(title, footnotes, label cells). 'Finally, it is possible to decide if the replacement will affect all pivot tables 'or only the selected pivot tables. 'The script replaces only the words contained in the list: even if only one word 'needs to be replaced, it must be added to the list. 'End Description 'ASSUMPTIONS 'An output window needs to be opened. The script acts only onto the designed 'output window. 'EFFECTS 'Replaces words contained in either pivot tables' title, label cells and footnotes 'of the designated output document. 'SPSS 7.5 'Author: Fabrizio Arosio (Fabrizio_Arosio@rotta.com) ' On version 11, the script was ending with an error message; I changed one ' line to fix it (see #### below). Raynald Levesque 2002/05/14. Option Explicit Const LIST_FILE_EXT="SR" 'defines the list file's extension Const EMPTY_ITEM=" "+vbNullChar Const PL_TITLE=1, PL_FOOT=2, PL_LABEL=4 'Arrays containing original and replacing words Public Orig() As String, Subst() As String 'Dialog box array list Public TheList() As String Sub SetList(atPos As Byte) 'update the atPos element of the array TheList TheList(atPos)=Orig(atPos+1)+" -> "+Subst(atPos+1) End Sub Sub LoadList Dim i As Byte 'counter variable ReDim TheList(0 To UBound(Orig)) As String For i=1 To UBound(Orig) SetList(i-1) Next i TheList(i-1)=EMPTY_ITEM End Sub Function CreateDialog(OnlySelected As Boolean, MatchCase As Boolean, Where As Integer) As Boolean 'Show the dialog end execute it. 'Returns in the parameter OnlySelected True if the user has requested only to 'work on the selected tables. 'Returns in the parameter MatchCase True in case the user wants to search by taking care 'of lowercase/uppercase letters. 'Returns in the parameter Where the code that specifies the places of the pivot 'table where to search & replace. ReDim TheList(0) As String TheList(0)=EMPTY_ITEM Begin Dialog UserDialog 550,329,"Search & Replace Pivot Tables Text",.DialogFunc GroupBox 10,0,530,231,"Replacing list",.GroupBox2 Text 20,21,90,14,"Original text:",.Txt1 Text 20,63,120,14,"Replacing text:",.Txt2 TextBox 20,35,510,21,.txtOrig TextBox 20,77,510,21,.txtSubst GroupBox 10,245,220,70,"Pivot tables to search&&replace:",.GroupBox1 OptionGroup .TablesToReplace OptionButton 20,266,160,14,"&All pivot tables",.optReplaceAll OptionButton 20,287,160,14,"&Selected pivot tables",.optReplaceSelected PushButton 450,273,90,21,"&Replace",.cmdReplace ListBox 20,119,510,77,TheList(),.ListBox CancelButton 450,301,90,21,.Quit Text 20,105,30,14,"List:",.Text3 PushButton 20,203,110,21,"Ad&d to list",.cmdAddtoList PushButton 140,203,110,21,"D&elete from list",.cmdDelfromList PushButton 350,203,90,21,"Sa&ve list",.cmdSaveList PushButton 450,203,80,21,"L&oad list",.cmdLoadList GroupBox 240,238,180,84,"Where to seach&&replace",.GroupBox3 CheckBox 270,259,90,14,"&Title",.chkOnTitle CheckBox 270,301,90,14,"&Footnotes",.chkOnFoot CheckBox 270,280,100,14,"&Label cells",.chkOnLblCells CheckBox 440,245,100,14,"&Match Case",.chkCase End Dialog Dim Dlg As UserDialog Dlg.chkOnTitle=1 Dlg.chkOnFoot=1 Dlg.chkOnLblCells=1 CreateDialog=Dialog(Dlg)<>0 OnlySelected=(Dlg.TablesToReplace=1) MatchCase=Dlg.chkCase Where=Dlg.chkOnTitle*PL_TITLE Or Dlg.chkOnFoot*PL_FOOT Or Dlg.chkOnLblCells*PL_LABEL End Function Sub InitializeList Dim NItem As Integer NItem=UBound(TheList) DlgValue "ListBox",NItem DlgEnable "cmdDelfromList",False DlgEnable "cmdAddtoList",False End Sub Function DialogFunc%(DlgItem$, Action%, SuppValue%) 'Performs dialog box functions Static NItem As Integer, NumItems As Integer Dim i As Integer, Num As Integer, FileName As String Select Case Action% Case 1 ' Dialog box initialization InitializeList Case 2 ' Value changing or button pressed DialogFunc% = True 'do not exit the dialog Select Case DlgItem$ Case "ListBox" 'list box item selected NItem=DlgValue ("ListBox") If NItem1 Then ReDim Preserve Orig(1 To UBound(Orig)-1) As String ReDim Preserve Subst(1 To UBound(Subst)-1) As String Else Erase Orig,Subst End If ReDim Preserve TheList(0 To UBound(TheList)-1) As String DlgListBoxArray "ListBox",TheList() DlgValue "ListBox",NItem Case "cmdSaveList" 'save list button pressed FileName=GetFilePath(,LIST_FILE_EXT,,"Save Search&Replace list",3) If FileName<>"" Then Num=FreeFile() Open FileName For Output As #Num Write #Num, UBound(Orig) For i=1 To UBound(Orig) Write #Num, Orig(i),Subst(i) Next i Close #Num End If Case "cmdLoadList" 'load list button pressed FileName=GetFilePath(,LIST_FILE_EXT,,"Load Search&Replace list",0) If FileName<>"" Then Num=FreeFile() Open FileName For Input As #Num Input #Num,NItem ReDim Orig(1 To NItem) As String ReDim Subst(1 To NItem) As String ReDim TheList(0 To NItem) As String For i=1 To NItem Input #Num,Orig(i),Subst(i) SetList(i-1) Next i Close #Num LoadList DlgListBoxArray "ListBox",TheList() InitializeList End If Case "cmdReplace" 'Replace button pressed DialogFunc% = False 'exit the dialog Case "Quit" 'Cancel button pressed DialogFunc% = False 'exit the dialog End Select Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle 'fill textboxes, enable/disable buttons If NItemUBound(TheList) Then DlgText "TxtOrig",Orig(NItem+1) DlgText "TxtSubst",Subst(NItem+1) NumItems=UBound(TheList) End If DlgText "cmdAddtoList","Change &item" DlgEnable "cmdDelfromList",True Else If NumItems<>UBound(TheList) Then DlgText "TxtOrig","" DlgText "TxtSubst","" NumItems=UBound(TheList) End If DlgText "cmdAddtoList","Ad&d to list" DlgEnable "cmdDelfromList",False End If DlgEnable "cmdAddtoList", Not(DlgText("TxtOrig")="" And DlgText("TxtSubst")="") DlgEnable "cmdSaveList", UBound(TheList)>0 DlgEnable "cmdReplace", UBound(TheList)>0 DialogFunc% = True End Select End Function Sub Main Dim objItems As ISpssItems, objPivot As PivotTable Dim Selected() As Integer Dim ItemIndex As Integer, NSelected As Integer Dim OnlySelected As Boolean, MatchCase As Boolean, WhereToChange As Integer 'create and run the dialog If Not CreateDialog(OnlySelected,MatchCase,WhereToChange) Then Exit Sub 'check dialog results If UBound(TheList)=0 Then MsgBox "Nothing to replace: List empty" Exit Sub End If If WhereToChange=0 Then MsgBox "No place specified where to search & replace" Exit Sub End If 'Continue the program only if there is at least one output document. If objSpssApp.Documents.OutputDocCount > 0 Then 'Get the currently designated output document items collection. Set objItems = objSpssApp.GetDesignatedOutputDoc.Items Else MsgBox "No Navigator window exists" Exit Sub End If 'Store the selected pivot tables indexes NSelected=0 For ItemIndex=0 To objItems.Count-1 With objItems.GetItem(ItemIndex) If .SPSSType=SPSSPivot And (.Selected Or Not OnlySelected) Then NSelected=NSelected+1 ReDim Preserve Selected(1 To NSelected) As Integer Selected(NSelected)=ItemIndex End If End With Next ItemIndex If NSelected=0 Then MsgBox "No Pivot tables to modify into the current Navigator window" Exit Sub End If 'modify all pivot tables selected into the output navigator For ItemIndex=1 To NSelected With objItems.GetItem(Selected(ItemIndex)) Set objPivot=.ActivateTable objPivot.UpdateScreen=False If WhereToChange And PL_TITLE Then 'modify table title objPivot.TitleText=GetNewLabel(objPivot.TitleText,MatchCase) End If If WhereToChange And PL_FOOT Then 'modify footnotes ModFootnotes objPivot.FootnotesArray,MatchCase End If If WhereToChange And PL_LABEL Then 'modify all column labels cells ModLabelsArrayCells objPivot.ColumnLabelArray,MatchCase 'modify all row labels cells ModLabelsArrayCells objPivot.RowLabelArray,MatchCase End If objPivot.UpdateScreen=True .Deactivate End With Next ItemIndex End Sub Sub ModFootnotes(ByVal objFootArray As ISpssFootnotes, ByVal MatchCase As Boolean) 'Modifies table footnotes Dim NCell As Long With objFootArray For NCell=0 To objFootArray.Count-1 .ValueAt(NCell)=GetNewLabel(.ValueAt(NCell),MatchCase) Next NCell End With End Sub Sub ModLabelsArrayCells(ByVal objLabelArray As ISpssLabels, ByVal MatchCase As Boolean) 'Modifies all valid cells of the label array Dim Rows As Long, Cols As Long, NotDisplayed As Boolean 'scan for all valid cells of table's label array NotDisplayed=False With objLabelArray For Rows=0 To .NumRows-1 For Cols=0 To .NumColumns-1 'modify the cell's string if it isn't null If Not IsNull(.ValueAt(Rows,Cols)) Then 'detect if the cell is displayed If Rows>0 Then If Not IsNull(.ValueAt(Rows-1,Cols)) Then NotDisplayed=.ValueAt(Rows-1,Cols)=.ValueAt(Rows,Cols) End If End If If Cols>0 Then If Not IsNull(.ValueAt(Rows,Cols-1)) Then NotDisplayed=NotDisplayed Or .ValueAt(Rows,Cols-1)=.ValueAt(Rows,Cols) End If End If 'replace the cell's text only if it is displayed and it isn't empty If .ValueAt(Rows,Cols)<>"" And Not NotDisplayed Then 'assign the new label .ValueAt(Rows,Cols)=GetNewLabel(.ValueAt(Rows,Cols),MatchCase) End If End If Next Cols Next Rows End With End Sub Function GetNewLabel(ByVal OldLabel As String, ByVal MatchCase As Boolean) As String 'Returns the label that replaces the old label Dim TextPos As Integer, StartPos As Integer, i As Integer Dim ModLabel As String ModLabel=OldLabel 'StartPos=0 '#### this line was replaced by the next StartPos=1 For i=1 To UBound(Orig) Do If MatchCase Then 'search by matching uppercase/lowercase characters TextPos=InStr(StartPos,ModLabel,Orig(i)) Else 'search without matching uppercase/lowercase characters TextPos=InStr(StartPos,UCase(ModLabel),UCase(Orig(i))) End If If TextPos>0 Then ModLabel=Left(ModLabel,TextPos-1)+Subst(i)+Mid(ModLabel,TextPos+Len(Orig(i)),Len(ModLabel)-TextPos-Len(Orig(i))+1) StartPos=TextPos+Len(Subst(i))-1 End If Loop Until TextPos=0 Next i GetNewLabel=ModLabel End Function