• Strona główna
  • Moje aplikacje
  • Oferta dla Klienta
  • Artykuły w pismach
  • Moja historia
  • Kontakt

Świat Excela

Blog nie tylko dla programistów VBA

  • Ciekawostki
  • Formuły
  • Makra
  • Tabele
  • Wykresy
  • Formularze
  • Narzędzia
  • Solver
  • Wstążka
  • SQL

121. Jak wyeksportować fragment arkusza do obrazka w wysokiej rozdzielczości?

29 sierpnia 2017 przez Mariusz Jankowski 1 komentarz

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 :).


  • Facebook
  • Twitter
  • Google+

W kategorii: Ciekawostki, Formularze, Makra, Wstążka, Wykresy Tagi:eksport, EMF, grafika, obraz, PNG, zdjęcie

Komentarze

  1. AvatarKingCrimson napisał

    24 września 2019 o 15:29

    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:

    objWykres.Activate

    Pozdrawiam!

    Zaloguj się, aby móc odpowiedzieć

Dodaj komentarz Anuluj pisanie odpowiedzi

Musisz się zalogować, aby móc dodać komentarz.

Strony polskie

  • 123office
  • Akademia VBA
  • Excel Szkolenie
  • Excelblog
  • Excelforum
  • ExcelPerfect
  • Kurs Excel
  • Skuteczne raporty
  • Skuteczny Office
  • VBA Online

Strony zagraniczne

  • Andy Pope
  • Automate Excel
  • Contextures
  • Daily Dose Of Excel
  • Easy Excel
  • Excel Guru
  • Mr Excel
  • Orlando MVP
  • Ron De Bruin
  • Spreadsheet Page

Kanały YouTube

  • Adam Kopeć (Excel.i Adam)
  • Bill Jelen (MREXCEL)
  • Bill Szysz
  • CREATIVEWISE SDN BHD
  • Mastering Excel
  • Mateusz Grabowski (iEXCELPL)
  • Mike Girvin (ExcelIsFun)
  • Piotr Majcher (PMSOCHO)
  • Przemysław Szyperski (ExcelSzkolenie)
  • Robert Kosztyla (Excelomania)

Prawo autorskie © 2019 · Metro Pro na Genesis Framework · WordPress · Zaloguj się