Niedawno stanąłem przed, łatwym z pozoru, zadaniem wyeksportowania zakresu komórek do pliku graficznego.
Wymogi Zadania
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 (dla każdej linii produkcyjnej).
Szukanie Rozwiązania
Jak to czasem 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.
Kolejność Działań
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
Skalowanie Obrazka
I właśnie w tym ostatnim linku przeczytałem, że aby polepszyć jakość tego końcowego pliku graficznego, należy zwiększyć jego skalę. Powiększyć go 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ł oryginalną jakość).
Kod Makra
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.
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
Screen z Rozwiązaniem
Tak oto, zakres komórek 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!
Potwierdzam. Problem występuje od wersji 2016 włącznie. Wystarczy dodać ta jedną linijkę i będzie działać 🙂