Excel - import obrázků

Vkládání obrázků do sešitů v excelu se může jevit jako efektní, nicméně při větším počtu obrázků značně neefektivní. S každým obrázkem dramaticky narůstá velikost výsledného sešitu.

Dynamické načítání obrázků

Řešením problému je dynamické načítání obrázků. Při použití níže uvedného makra bude sešit obsahovat vždy pouze 1 obrázek, který bude navíc odstraněn před každým uložením. Velikost výsledného souboru tak bude stejná, jako kdyby sešit žádný obrázek neobsahoval.

Stáhnout vzorový sešit (zip, 186 kB), 17. 3. 10

Postup

Při každé změně na listu bude z předem určené složky načten obrázek, jehož název je uveden v konkrétní buňce. Proto je třeba kód umístit jinam, než do standardního modulu.

Klávesovou zkratkou Alt + F11 se dostaneme do editoru VBA.
V levé části okna poklepeme levým tlačítkem myši na aktivní list (List1).
V zobrazném okně vybereme z levého rozbalovacího seznamu položku Worksheet a z pravého položku SelectionChange.

Na místo kurzoru vložíme následující proceduru.

Option Explicit

Application.ScreenUpdating = False
On Error Resume Next
Dim oblast As String, vlozit As String, _
    slozka As String, adresa As String, _
    pripona As String, nazev As String

'definování proměnných
oblast = "A1"                                   'buňka, kde bude název obrázku
vlozit = "C1"                                   'buňka, do které se obrázek vloží
slozka = "obr"                                  'podsložka, kde jsou obrázky umístěné
adresa = ThisWorkbook.Path & "\" & slozka & "\" 'kompletní adresa pro vyhledání obrázků
pripona = "jpg"                                 'přípona (formát) obrázků
nazev = Range(oblast).Value & "." & pripona     'jméno souboru s příponou k vyhledání

'vymazání všech obrázků na aktivním listu
For Each img In ActiveSheet.Pictures
    img.Delete
Next img

'vložení nového obrázku do buňky C1
Range(vlozit).Select
ActiveSheet.Pictures.Insert adresa & nazev

Range(oblast).Select
Application.ScreenUpdating = True

Tím je zajištěno dynamické načítání obrázků. Nyní je ještě třeba zajistit, aby se obrázek smazal před uložením a nezvětšoval tak velikost celého souboru.

V editoru tentkorát poklepeme na položku ThisWorkbook.
V zobrazném okně vybereme z levého rozbalovacího seznamu položku Workbook a z pravého položku BeforeSave.
Na místo kurzoru vložíme následující proceduru.

For Each img In ActiveSheet.Pictures
    img.Delete
Next img