excel - Reports on Pivot Tables - Getting Slicers', Charts' and Filters' info -
i'm working on big reporting system lot of pivot tables, pivot charts, slicers , filters.
so sure all pivot tables have right sources , slicers apply each 1 of them, started work on code aggregate useful info each pivot table :
sub test_2_pt_report_by_sheet() thisworkbook.save application.screenupdating = false dim pt pivottable, _ sl slicer, _ rws worksheet, _ ws worksheet, _ pf pivotfilter, _ pfl pivotfield, _ headers string, _ tpstr string, _ sp() string, _ a() redim a(20, 0) set rws = thisworkbook.sheets("pt_report") headers = "name/sheet/address/version/source/slicercache/refreshed/slicer_number/slicers/slicers_values" & _ "activefilters/filters/activevalues/haschart/chart_location/ / / / / / " = lbound(a, 1) ubound(a, 1) a(i, 0) = split(headers, "/")(i) next on error resume next each ws in thisworkbook.sheets each pt in ws.pivottables tpstr = vbnullstring redim preserve a(ubound(a, 1), ubound(a, 2) + 1) pt a(0, ubound(a, 2)) = .name a(1, ubound(a, 2)) = ws.name a(2, ubound(a, 2)) = replace(.tablerange2.address & " / " & .tablerange1.address, "$", "") a(3, ubound(a, 2)) = .version a(4, ubound(a, 2)) = .sourcedata a(5, ubound(a, 2)) = "" '.pivotcache.name a(6, ubound(a, 2)) = .refreshdate a(7, ubound(a, 2)) = .slicers.count each sl in .slicers tpstr = tpstr & "/" & sl.name '& " : " & sl.shape.parent.name next sl if len(tpstr) > 0 a(8, ubound(a, 2)) = right(tpstr, len(tpstr) - 1) tpstr = vbnullstring sp = split(a(8, ubound(a, 2)), "/") = lbound(sp) ubound(sp) tpstr = tpstr & "/" & getselectedsliceritems(sp(i)) next if len(tpstr) > 0 a(9, ubound(a, 2)) = right(tpstr, len(tpstr) - 1) if .version = xlpivottableversion12 tpstr = vbnullstring each pf in .activefilters tpstr = tpstr & "/" & pf.pivotfield.name next pf if len(tpstr) > 0 a(10, ubound(a, 2)) = right(tpstr, len(tpstr) - 1) else end if tpstr = vbnullstring each pfl in .datafields tpstr = tpstr & "/" & pfl.name next pfl if len(tpstr) > 0 a(11, ubound(a, 2)) = right(tpstr, len(tpstr) - 1) 'a(12, ubound(a, 2)) = .visiblefields 'a(13, ubound(a, 2)) = ' a(14, ubound(a, 2)) = ' a(15, ubound(a, 2)) = ' a(16, ubound(a, 2)) = ' a(17, ubound(a, 2)) = ' a(18, ubound(a, 2)) = .pivotchart.haschart ' a(19, ubound(a, 2)) = .pivotchart.chart.shapes.name ' a(20, ubound(a, 2)) = end next pt next ws rws.cells.clearcontents rws.cells.clearformats rws.range("a1").resize(ubound(a, 2) + 1, ubound(a, 1) + 1).value = application.transpose(a) rws.columns("a:z").entirecolumn.autofit rws.activate set ws = nothing set rws = nothing application.screenupdating = true msgbox "done" end sub and function selected items in slicer :
public function getselectedsliceritems(slicername string) string dim osc slicercache dim osi sliceritem dim lct long application.volatile on error resume next set osc = thisworkbook.slicercaches("slicer_" & replace(slicername, " ", "")) if not osc nothing each osi in osc.sliceritems if osi.selected getselectedsliceritems = getselectedsliceritems & osi.name & ", " lct = lct + 1 elseif osi.hasdata = false lct = lct + 1 end if next if len(getselectedsliceritems) > 0 if lct = osc.sliceritems.count getselectedsliceritems = "all items" else getselectedsliceritems = left(getselectedsliceritems, len(getselectedsliceritems) - 2) end if else getselectedsliceritems = "no items selected" end if else getselectedsliceritems = "no slicer name '" & slicername & "' found" end if end function issues
slicers
sl.shape.parent.name works when slicer on same sheet pivot table. , can't seem locate more accurately on sheet (not dramatic).
when use pt.slicers(1).parent.name or pt.parent.name, sheet's name, want slicercache's name. (maybe loop on slicercaches rather sheets, , use 1 of these expressions sheet name)
charts
i struggle work pivot charts, property haschart in pivot chart object... wanted know if there one, , how named. thought of function error handling avoid breaks i'm not sure best way.
activefilters , pivot table version
for activefilters, error message tables:
this pivot table created in later version of excel , can't updated in version.
i created few pivot tables in excel 2013 , work on 2010, tried filter version, have same : xlpivottableversion14 (value = 4), except 1 give 5 hasn't constant describe it... edit : on excel 2013, found : const xlpivottableversion15 = 5
so, enlightenment, advice or workaround welcome!
there's slicercaches collection in worbook object.
dim sc slicercache each sc in thisworkbook.slicercaches debug.print sc.parent.name ' returns workbook name each pt in sc.pivottables debug.print pt.name ' returns pivot table name debug.print pt.sourcedata ' returns source range debug.print pt.parent.name ' returns sheet name next next this way, can track pivots associated slicers , corresponding source data.
for charts, best bet use shapes object.
dim sh shape dim ch chartobject each sh in sheet1.shapes if sh.type = msochart set ch = sh.oleformat.object on error resume next ' source pivot table debug.print ch.chart.pivotlayout.pivottable.name ' location of pivot table debug.print ch.chart.pivotlayout.pivottable.parent.name ' source range debug.print ch.chart.pivotlayout.pivottable.sourcedata on error goto 0 ' how named debug.print ch.chart.parent.name ' location of chart debug.print ch.chart.parent.parent.name end if next of course, you'll need use oern + oeg0 if happen have normal chart.
result runtime since no pivotlayout associated it.
for activefilters, collection. active filters, can try:
dim pt pivottable dim pf pivotfilter set pt = sheet1.pivottables("pivottable1") each pf in pt.activefilters debug.print pf.filtertype ' returns filter type debug.print pf.value1 ' returns value on error resume next debug.print pf.datafield.name ' returns field name on error goto 0 next datafield used when filter type associated values.
if not, , filter labels, throw runtime.
for version, don't think have problem retrieving information?
Comments
Post a Comment