Dosyć niedawno stanąłem przed bardzo łatwym z pozoru zadaniem, wyeksportowania zakresu komórek (zawierającego m.in. wykres) do pliku graficznego. Warunki dotyczące tego obrazka były dwa: po pierwsze – koniecznie musiał to być format PNG, po drugie – zdjęcie musiało być świetnej jakości (służyło ono w celach wizualizacji i miało być wyświetlane na kilku wielkich monitorach).
Jak to czasami bywa w życiu (programisty VBA) prace nad częścią projektu mogą się nieoczekiwanie wydłużyć. Wiedziałem, że Excel nie oferuje żadnego prostego sposobu na wyeksportowanie zakresu komórek do formatu graficznego (przydałaby się jakaś metoda typu ExportToPicture dla obiektu Range). Wiedziałem też jednak, że istnieje sposób na eksport wykresu do pliku graficznego. Nie wszystko więc stracone!
Najpierw przeszukałem jednak internet w poszukiwaniu jakiegoś makra opartego o funkcje API i trafiłem na bardzo dobry kod. Niestety funkcja nie spełniała pierwszego warunku (format docelowy to EMF) i pomimo świetnej jakości screena, musiałem wrócić do punktu wyjścia. Później znalazłem w internecie inny kod, wraz z bardzo cenną informacją na temat tego, w jaki sposób poprawić jakość obrazka.
Oczywiście wszystko trzeba było zrobić okrężną drogą:
- (opcjonalnie) dodać nowy, tymczasowy arkusz
- utworzyć w nim nowy wykres o wymiarach identycznych z zakresem komórek
- zrobić screen zakresu komórek i wkleić go właśnie w miejsce wykresu
- wyeksportować wykres do pliku graficznego
- (opcjonalnie) skasować tymczasowy arkusz
I właśnie w tym ostatnim linku przeczytałem, że aby zwiększyć rozdzielczość/jakość tego końcowego pliku graficznego, należy zwiększyć jego skalę (powiększyć dwu lub trzykrotnie) zaraz po wklejeniu w obszar wykresu, ale tuż przed eksportem. Taka operacja co prawda mocno zwiększy rozmiar pliku, ale plik zyska na jakości. Mogę potwierdzić, że tak faktycznie jest, ale często w momencie eksportu Excel się zawieszał (sprawdzone na dwóch komputerach), więc ostatecznie zdecydowałem się, że nie będę wpływał na rozmiar obrazka (Klient zaakceptował tą oryginalną jakość).
Kod, który realizuje to zadanie zamieszczam poniżej. Makro główne wywołuje jedynie funkcję główną, która posiada dwa argumenty: zakres komórek do wyeksportowania, docelowa lokalizacja pliku graficznego. Zakres nazywa się Layout, natomiast lokalizacją jest zaszyta w stałej.
'// Autor : Mariusz Jankowski Private Const msMODUL As String = "MEksportDoObrazka" Option Explicit Public Sub MakroGlowne() Const sPROC As String = "MakroGlowne" Const sLOKALIZACJA_PNG As String = "C:\Users\Mariusz\Desktop\Layout.PNG" 'Wywołaj makro eksportujące 1 EksportujDoPng wksLayout.Range("Layout"), sLOKALIZACJA_PNG End Sub Public Sub EksportujDoPng(ByRef rngEksport As Range, ByVal sSciezkaDoPng As String) '// Makro eksportuje zakres komórek do pliku graficznego PNG. '// Procedura posiada dwa argumenty: pierwszy to obszar do wyeksportowania, '// drugi natomiast to pełna lokalizacja pliku na dysku Dim wksTemp As Worksheet Dim objWykres As ChartObject Dim objCzart As Chart Const iSKALA As Integer = 1 Const sPROC As String = "EksportujDoPng" 'Aktywuj obsługę błędów na starcie 1 On Error GoTo ObslugaBledu 'Dodaj arkusz tymczasowy 2 Set wksTemp = ThisWorkbook.Sheets.Add 'Dodaj wykres rozmiarem identyczny z zakresem komórek 3 With rngEksport 4 Set objWykres = wksTemp.ChartObjects.Add(.Left, .Top, .Width, .Height) 5 End With 6 Set objCzart = objWykres.Chart 'Kopiuj zakres jako obrazek 7 rngEksport.CopyPicture xlScreen, xlPicture 8 objCzart.Paste 'Uwaga! W razie potrzeby podaj większą wartość dla stałej iSKALA 9 With wksTemp 10 .Shapes(1).ScaleWidth iSKALA, msoFalse, msoScaleFromTopLeft 11 .Shapes(1).ScaleHeight iSKALA, msoFalse, msoScaleFromTopLeft 12 End With 'Eksportuj wykres do pliku graficznego 13 objCzart.Export Filename:=sSciezkaDoPng, FilterName:="PNG" 'Skasuj arkusz tymczasowy 14 Application.DisplayAlerts = False 15 wksTemp.Delete 16 Application.DisplayAlerts = True Wyjscie: 17 Set wksTemp = Nothing 18 Set objWykres = Nothing 19 Set objCzart = 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
Taki oto zakres komórek (zawierający wykres) został zapisany do pliku graficznego. Część projektu wykonana, można przejść do następnej :).
W przypadku niektórych wersji Excela występuje problem z działaniem makra (generuje puste-białe pliki png). Jako obejście problemu należy między linią kodu 5 i 6 (po End With) dodać aktywację obiektu objWykres, czyli dodać linijkę kodu:
Pozdrawiam!