Basic iteration of Slicers in Excel

Basic Iteration of Slicers in Excel

 Keywords:  Slicer Slicers PivotTables Pivot Tables Excel SlicerCaches

;Winbatch 2014A - Basic iteration of Slicers in Excel
;
;Uses sample workbook with Pivot Table and Slicers
;
;The script opens the workbook, gathers each slicer by name and it's associared
;Pivot Table, then further iterates each item within each slicer and whether or not
;it is selected.
;
;As slicer properties are get/set this gives control over what is displayed to the end
;user. There are other importgant properties that can be evaluated and I hope to come
;up with a more robust example at a later point.
;
;Stan Littlefield: May 26, 2014
;/////////////////////////////////////////////////////////////////////////////////////////////
GoSub udfs
IntControl(73,1,0,0,0)
oXL=0

cXLS=""
noXL()
BoxOpen("Please Wait","Opening Workbook")
If ! loadxl(1) Then Terminate(@TRUE,"Cannot Continue","Cannot Start Excel")
cSC=""
cItems=""

If oXL.ActiveWorkBook.SlicerCaches.Count>0
   ForEach SC In oXL.ActiveWorkBook.SlicerCaches
      ForEach PT In SC.PivotTables
        PT.Parent.Activate
        cSC=cSC:SC.Name:',':PT.Parent.Name:@TAB
      Next
   Next
   n=ItemCount(cSC,@TAB)

   For i=1 To n-1
      cI=ItemExtract(1,ItemExtract(i,cSC,@TAB),",")
      cItems=cItems:cI:@CRLF
      ForEach cIT In oXL.ActiveWorkbook.SlicerCaches("%cI%").SlicerItems
         cItems=cItems:cIT.Value:",":cIT.Selected:@CRLF
      Next
     cItems=cItems:@CRLF:@CRLF
   Next
Else
   cSC="This Workbook Has No Slicers"
EndIf
If oXL<> 0 Then oXL.Quit()
cSC=StrReplace(cSC,@TAB,@CRLF)
Message("Slicers",cSC:@CRLF:@CRLF:cItems)

:End

Exit

:WBERRORHANDLER
oXL=0
ErrorProcessing(0,1,0,0)
Exit

:udfs
#DefineSubRoutine ErrorProcessing(deleteIni,showerr,logfile,Err_Array)
If VarType(Err_Array) ==256
   WbError = Err_Array[0]
   wberrorhandlerline = Err_Array[1]
   wberrorhandleroffset = Err_Array[2]
   wberrorhandlerassignment = Err_Array[3]
   wberrorhandlerfile = Err_Array[4]
   wberrortextstring = Err_Array[5]
   wberroradditionalinfo = Err_Array[6]
   wberrorinsegment = Err_Array[7]
Else
   WbError = LastError()
EndIf
WbTextcode = WbError
If WbError==1668||WbError==2669||WbError==3670
   WbError = ItemExtract(1,IntControl(34,-1,0,0,0),":")
   WbTextcode = -1
EndIf
WbErrorString = IntControl(34,WbTextcode,0,0,0)
WbErrorDateTime = TimeYmdHms()
If deleteIni
   WbErrorFile = StrCat(ShortCutDir( 'AppData', 0, 0 ),'\WinBatch\Settings\')
   If ! DirExist(WbErrorFile) Then WbErrorFile = DirWindows(0)
   WbErrorFile = StrCat(WbErrorFile,"WWWBATCH.INI")
   FileDelete(WbErrorFile)
   IniWritePvt(WbErrorDateTime,"CurrentScript",WbErrorHandlerFile      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorValue"   ,WbError                 ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorString"  ,WbErrorString           ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptLine"   ,WbErrorHandlerLine      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptOffset" ,WbErrorHandlerOffset    ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarAssignment",WbErrorHandlerAssignment,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarInSegment" ,WbErrorInSegment,WbErrorFile)
   IniWritePvt("","","",WbErrorFile)
EndIf
WbErrorMsgText = StrCat(WbErrorDateTime,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Current Script: ",WbErrorHandlerFile,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error# [",WbError,"]",@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error Text: ",wberrortextstring,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Extended Information] ",wberroradditionalinfo,@CRLF,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"On Line:",@CRLF,WbErrorHandlerLine,@CRLF)
;WbErrorMsgText = StrCat(WbErrorMsgText,"Offset: ",WbErrorHandlerOffset,@CRLF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "UNKNOWN"
WbErrorMsgText = StrCat(WbErrorMsgText,"Assignment/Variable: ",WbErrorHandlerAssignment,@CRLF)
If (WbErrorInSegment>"") Then WbErrorMsgText = StrCat(WbErrorMsgText,"In UDF/UDS: ",WbErrorInSegment,@CRLF)
If logfile
   cSep = StrCat(StrFill("=",50),@CRLF)
   cLogFile = StrCat(DirScript(),"log.err")
   If ! FileExist(cLogFile) Then FilePut(cLogFile,StrCat("Error Log",@CRLF,cSep))
   FilePut(cLogFile,StrCat(FileGet(cLogFile),WbErrorMsgText,cSep))
   Display(2,"An Error Occured",StrCat("written to ",cLogFile))
Else
   If showerr
      WbErrorMsgText = StrCat(WbErrorMsgText,"[THIS ERROR NOT WRITTEN TO LOG FILE]",@CRLF)
      Message("An Error Was Encountered",WbErrorMsgText)
   EndIf
EndIf
Return(1)
#EndSubRoutine

#DefineSubRoutine loadxl(mode)
IntControl(73,1,0,0,0)
oXL = CreateObject("Excel.Application")
If oXL == 0 Then Return(0)
If mode
   oXL.WorkBooks.Open(cXLS)
Else
   oXL.WorkBooks.Add()
EndIf
While ! oXL.Ready
   TimeDelay(1)
EndWhile
BoxShut()
oXL.Visible          = 1  ;Excel will not be visible
oXL.ScreenUpdating   = 1  ;these next 3 increase speed of processing
oXL.UserControl      = 1
oXL.DisplayAlerts    = 0
Return(1)

:WBERRORHANDLER
IntControl(73,1,0,0,0)
Return(0)

#EndFunction


#DefineSubRoutine noXL()
NXLFormat=`WWWDLGED,6.2`
NXLCaption=`Please Select Excel File To Examine`
NXLX=9999
NXLY=9999
NXLWidth=114
NXLHeight=045
NXLNumControls=002
NXLProcedure=`DEFAULT`
NXLFont=`DEFAULT`
NXLTextColor=`DEFAULT`
NXLBackground=`DEFAULT,DEFAULT`
NXLConfig=0

NXL001=`007,011,036,012,PUSHBUTTON,"PushButton_OK",DEFAULT,"Search",1,10,32,DEFAULT,DEFAULT,"0|255|64"`
NXL002=`065,011,036,012,PUSHBUTTON,"PushButton_Cancel",DEFAULT,"Cancel",0,20,DEFAULT,DEFAULT,DEFAULT,"255|0|0"`

BP=Dialog("NXL")


If BP==1
   filetypes="Excel File|*.xlsx;*.xls;*.xlsm;*.csv"
   cXLS = AskFilename("Select Workbook", DirScript(),filetypes, "", 1)
   Return(1)
Else
   Exit
EndIf

Return(0)
:CANCEL
Exit
#EndSubRoutine


Return

Article ID:   W18529

Filename:   Basic iteration of Slicers in Excel.txt

File Created: 2014:05:30:12:23:58

Last Updated: 2014:05:30:12:23:58

Database Search

TechHome

Basic Iteration of Slicers in Excel