Dzisiaj pokażę jak zbudować łatwy w rozwoju schemat do generowania raportów. Przyjmijmy, że w naszym skoroszycie mamy dużą tabele (100 kolumn i kilka tysięcy wierszy). Nasz aplikacja ma w oparciu o tą tabelę generować raporty. Każdy raport zapisywany jest w nowym skoroszycie. Oczywiście, jak to zwykle bywa, nie znamy listy raportów, które będą generowane przez naszą aplikację. W praktyce oznacza to dla nas tyle, liczba kolumn i wierszy w raporcie może być dowolna.
Krok 1 - Budujemy środowisko testowe
Zacznijmy od przygotowania prototypu symulującego zachowanie raportu. A naszym pliku stwórzym arkusz RAPORT, a następnie przygotujmy w nim poniższą tabelę.
Nasza procedura testująca będzie ładowała powyższy zakres do 2 tablic -- pierwszej, która zawiera nagłówki kolumn raportu, oraz drugiej która zawierać będzie jego treść. Te tablice wykorzystam jako dane wejściowe do wygenerowania raportu.
Kod procedury testującej wygląda następująco
Sub ProceduraTestujaca() 'ustawiamy arkusz z danymi testowymi Dim wksDaneTestowe As Worksheet 10 Set wksDaneTestowe = ThisWorkbook.Worksheets("Test") 'tablice zawierajace naglowek Dim headRaport As Variant 'oraz tresc raportu Dim bodyRaport As Variant 'Ładujemy naglowki do tablicy Dim headRange As Range 20 Set headRange = wksDaneTestowe.Range( _ wksDaneTestowe.Range("A1").Address, _ wksDaneTestowe.Range("A1").End(xlToRight).Address) 30 headRaport = headRange 'oraz ciało Dim bodyRange As Range 40 Set bodyRange = wksDaneTestowe.Range( _ wksDaneTestowe.Range("A2").Address, _ wksDaneTestowe.Range("A2").End(xlToRight).End(xlDown).Address) 50 bodyRaport = bodyRange 'sprawdzamy czy jest dane sie załadowały 60 MsgBox UBound(headRaport, 2) 'ile kolumn ma naglowek 70 MsgBox UBound(bodyRaport, 1) 'ile wierszy ma raport 'czyścimy po sobie 80 Set wksDaneTestowe = Nothing 90 Set headRange = Nothing 100 Set bodyRange = Nothing End Sub
Krok 2 - Składniki, czyli funkcje
Nasz moduł do tworzenia raportów będzie składał się z trzech funkcji. Pierwsza stworzy nowy arkusz, druga sformatuje nagłówek raportu, a trzecia jego wiersze. Funkcję, która posłuży nam do stworzenia nowego arkusza opisałem już w jednym z poprzednich postów. Poniżej zmodyfikowałem ją nieco żeby zwracała nam jako obiekt arkusz, w którym powstanie raport
Function createNewSheet(nazwa As String) As Worksheet Dim Skoroszyt As Workbook Set Skoroszyt = Application.Workbooks.Add() Dim Arkusz As Worksheet For Each Arkusz In Skoroszyt.Worksheets If Arkusz.Name = "Arkusz1" Then Arkusz.Name = nazwa Else Application.DisplayAlerts = False Arkusz.Delete Application.DisplayAlerts = True End If Next Set createNewSheet = Skoroszyt.Worksheets(nazwa) End Functio
Do stworzenia nagłówka raportu wykorzystamy następującą funkcję:
Sub GenerowanieNaglowka(arkusz As Worksheet, naglowek as Variant) 'w arkuszu z raportem tworzymy zakres zawierający komórki do sformatowania 'w naszym przypaku nagłówek zawsze będzie znajdował się w pierwszym wierszu arkusza Dim Zakres As Range Set Zakres = arkusz.Range(arkusz.Cells(1, 1), arkusz.Cells(1, UBound(naglowek, 1))) 'formatujemy zakres z nagłówkiem With Zakres With .Font .Name = "Arial" .Size = 8 .ColorIndex = 2 End With With .Interior .ColorIndex = 1 End With With .Borders .LineStyle = xlContinuous .ColorIndex = 1 End With .EntireColumn.ColumnWidth = 10 .WrapText = True .HorizontalAlignment = xlCenter End With 'zapisujemy nagłówki kolumn do naszego zakresu Zakres.Value = naglowek End Sub
Do funkcji przekazywane są dwa parametry -- obiekt arkusz w którym będą przechowywane dane oraz tablica z naglówkami. Funkcja najpierw tworzy zakres o odpowiedniech dla nagłówka rozmiarach, następnie formatuje go i na końcu zapisuje do niego wartości. Oczywiście przedstawione w funkcji formatowanie jest bardzo uproszczone. Jeżeli chcemy zrobić coś bardziej wyrafinowanego, to proponuję nagrać makro formatujące jedną komórkę w taki sposób jak chcemy, a następnie podlglądnąć jego składnię, formatowania należy szukać w bloku.
With Selection .HorizontalAlignment = xlCenter .... End With
Teraz wystarczy tylko przekleić interesujący nas fragment, zamienić Selection na Zakres i nasz nagłówek jest gotowy.
Ostatnią z funkcji będzie odpowiadała za formatowanie i zapis właściwej części raportu. Wygląda ona bardzo podobnie do funkcji generującej nagłówek
Sub GenerowanieBody(Arkusz As Worksheet, naglowek As Variant) Dim Zakres As Range Set Zakres = Arkusz.Range(Arkusz.Cells(2, 1), _ Arkusz.Cells(UBound(naglowek, 1) + 1, UBound(naglowek, 2))) With Zakres With .Borders .LineStyle = xlContinuous End With With .Font .Name = "Arial" .Size = 8 End With .Columns.AutoFit End With Zakres.Value = naglowek End Sub
Łączymy wszystko razem
Aby uruchomić naszą aplikację podmieniamy liniki z numerami 60 i 70 poniższymi
60 Dim wksRaport As Worksheet Set wksRaport = createNewSheet("RAPORT") Call GenerowanieNaglowka(wksRaport, headRaport) 70 Call GenerowanieBody(wksRaport, bodyRaport)
I to wszystko. W 90 linijkach udało stworzyć nam się prostą i elastyczną sturkturę do genrowania raportów.