Change pivot table text

'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