Search label in Output Window
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | 'Search label in Outpur window 'Begin Description 'This searches the left pane of the Designated Output window for Items 'containing strTitle where strTitle is given by the user at run time. Search is not case sensitive. 'After each find, the item is displayed in right pane and user 'can either continue search or stop it 'Requirement: the Output Document must be open. 'For convenience attach this script to a toolbar button 'End Description 'Author: Raynald Levesque 2003/01/23 'http://pages.infinit.net/rlevesqu/index.htm Option Explicit Sub main Call SearchLabel() End Sub Sub SearchLabel() ' PageTitle in left pane is replaced by content of right pane ' Acts on designated output window Dim objOutputDoc As ISpssOutputDoc Dim objOutputItems As ISpssItems Dim objOutputItem As ISpssItem Dim bolFound As Boolean Dim strTitle As String Dim cnt As Integer On Error GoTo Oopps bolFound = False ' Request search string strTitle=UCase(InputBox("Enter text","Find Item with the following Label")) If Len(strTitle)=0 Then Exit Sub 'Get designated output document and items collection Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc Set objOutputItems = objOutputDoc.Items objOutputDoc.ClearSelection ' Check every items For cnt = 0 To objOutputItems.Count - 1 Set objOutputItem = objOutputItems.GetItem(cnt) Debug.Print objOutputItem.Label If InStr(UCase(objOutputItem.Label),strTitle) > 0 Then bolFound = True objOutputItem.Selected = True If Len(InputBox("OK if yes, Cancel To terminate","Continue search?","Yes")) =0 Then Exit Sub End If objOutputItem.Selected = False End If Next If bolFound =False Then MsgBox("No output label contain: " & strTitle) Else MsgBox("There are no other items containing : " & strTitle) End If Exit Sub Oopps: MsgBox Err.Number & " " & Err.Description 'inform user Debug.Print Err.Number & " " & Err.Description 'for future reference 'Resume Next 'use Resume Next when debugging script End Sub |
Related pages
...