Podsumowania
Bardzo często możemy się spotkać z kodem, który tworzy w dodatkowym arkuszu pewne podsumowania. Popularnym działaniem tego typu jest np. utworzenie listy komentarzy lub formuł znajdujących się we wszystkich arkuszach skoroszytu.
Takie podsumowanie zawiera mnóstwo informacji pomocniczych. W przypadku komentarzy może to być nie tylko adres komórki z komentarzem, ale też np. jego treść lub dane użytkownika, który dodał taki komentarz (przydatne, gdy plik jest współdzielony).
W przypadku formuł w spisie można zawrzeć treść samych formuł w notacji A1 i R1C1, jak również wyniki, które zwracają.
Spis Pivotów
Podobny spis możemy utworzyć w przypadku tabel przestawnych, tym bardziej, że obiekt PivotTable jest niezwykle bogaty we właściwości. Próbka takiego makra znajduje się poniżej.
Screen
Kod Makra
Private Const msMODUL As String = "Module1"
Option Explicit
Public Sub ListaPivotow()
'// Makro tworzy listę tabel przestawnych
Const sPROC As String = "ListaPivotow"
Dim wksArkusz As Worksheet ' Pojedynczy arkusz w pliku
Dim pvtPivot As PivotTable ' Obiekt tabeli przestawnej
Dim iLicznik As Integer ' Będziemy zwiększać o 1
Dim avPivoty() As Variant ' Wszystkie dane znajdą się w tablicy
'Aktywuj obsługę błędów na starcie
1 On Error GoTo ObslugaBledu
'Pętla po arkuszach w pliku
2 For Each wksArkusz In ThisWorkbook.Worksheets
'Pętla po tabelach przestawnych w pliku
3 For Each pvtPivot In wksArkusz.PivotTables
'Zwięszamy indeks
4 iLicznik = iLicznik + 1
'Zwiększamy rozmiar tablicy
5 ReDim Preserve avPivoty(1 To 7, 1 To iLicznik)
'Zaczytajemy dane do tablicy
6 With pvtPivot
7 avPivoty(1, iLicznik) = .Name
8 avPivoty(2, iLicznik) = .Parent.Name
9 avPivoty(3, iLicznik) = .CacheIndex
10 avPivoty(4, iLicznik) = .SourceData
11 avPivoty(5, iLicznik) = .TableRange2.Address(External:=True)
12 avPivoty(6, iLicznik) = .RefreshDate
13 avPivoty(7, iLicznik) = .RefreshName
14 End With 'With wksListaPivotow
15 Next pvtPivot 'For Each pvtPivot In wksArkusz.PivotTables
16 Next wksArkusz 'For Each wksArkusz In ThisWorkbook.Worksheets
'Zaczytaj do arkusza
17 wksListaPivotow.Range("A2").Resize(iLicznik, 7) = WorksheetFunction.Transpose(avPivoty)
Wyjscie:
18 Set wksArkusz = Nothing
19 Set pvtPivot = Nothing
20 On Error GoTo 0
21 Exit Sub
ObslugaBledu:
22 Application.ScreenUpdating = True
23 MsgBox "Wystąpił błąd nr " & Err.Number & " (" & Err.Description & ")." _
& vbCr & vbCr & "Linia kodu nr " & Erl & " w procedurze """ & _
sPROC & """ modułu """ & msMODUL & """.", vbInformation, "BŁĄD!"
24 Resume Wyjscie
End Sub
