Tak zkus nasledujici kod. Neznam strukturu Tveho listu s KT, tedy nevim kam to vypsat, takze provizorne jsem to udelal tak, aby to vypsalo zafiltrovane polozky na novy list. (Nebude problem to zobrazit jinde, az bude jasno kam).
Co ale asi budes muset upravit v kodu je volba spravneho indexu (cislo sloupce v DB, na ktery je nasazen filtr KT) anebo vypsat jeho nazev. Je to v kodu okomentovano, nemam strach, ze by ses na tomto zasekl.
Sub VypisFiltruPoleKT()
Dim i As Integer, j As Integer
Dim wsPiv As Worksheet, wsNew As Worksheet
Dim KT1 As PivotTable, KTpole As PivotField
Set wsPiv = ActiveSheet 'list s KT
'zjisti, jestli tam opravdu nejaka KT je
On Error Resume Next
'Kdyby na tom liste bylo vice KT, tak zkusmo indexem najdes tu spravnou
Set KT1 = wsPiv.PivotTables(1)
'pokud neni, hodi to chybu
If Err <> 0 Then
MsgBox "Na aktivnim liste neni zadna KT"
GoTo fiNito
End If
On Error GoTo 0
'pridej novy list, at vime kam vypsat filtrovane polozky
Set wsNew = Worksheets.Add
'zde je potreba urcit spravne pole KT, ktere nas zajima
' bud pomoci indexu: KT1.PivotFields(i), pricemz v zavorce je cislo sloupce z databaze
' anebo natvrdo, napr. KT1.PivotFields("Zakaznik")
Set KTpole = KT1.PivotFields(4)
wsNew.Cells(1, 1) = KTpole.Name
j = 1
For i = 1 To KTpole.PivotItems.Count
If KTpole.PivotItems(i).Visible = True Then
j = j + 1
wsNew.Cells(j, 1) = KTpole.PivotItems(i)
End If
Next i
fiNito:
On Error GoTo 0
End Subcitovat
RSS nejnovější články