Tabulka jako pozadí na Ploše

Úvodní stránka | Blog | Excel VBA | Tabulka jako pozadí na Ploše

    • K čemu by tabulka jako pozadí na ploše mohla sloužit? Představte si sešit Excelu, v němž uživatelé často mění data. Nechcete jej opakovaně otevírat a zajímá vás jen určitý výřez buněk. Co takhle si oblast buněk dát jako obrázek na pozadí Plochy a aktualizovat při každém uložení sešitu?

    V první fázi se musíme naučit přebírat oblast buněk jako obrázek a ukládat ji do souboru. Běžný postup využívá plochy grafu. Tento způsob se táhne napříč celým internetem, ačkoliv už v roce 2000 přišel Stephen Lebans s řešením čistě přes API funkce. Za to mu patří dík. V níže přiloženém souboru je jádro řešení umístěno v modulu modAPIBitmapToFile. Výřez buněk nemusí být viditelný a není ovlivněn buňkovým kurzorem.

    Ve svém příkladu jsem použil obrázek na pozadí (karta Rozložení stránky), schoval přebytečné řádky a sloupce (pozadí se pod nimi dlaždicově opakuje a toto chování nelze ovlivnit) a skryl mřížku a záhlaví (viz karta Zobrazení). S užitím obrázku na pozadí jsem si ovšem naběhl. Excel obsahuje bug, kdy po otevření sešitu a listu s pozadím a bez záhlaví je pozadí odskočeno od počátku tak, jako by na listu záhlaví zobrazeno bylo. Napravit to můžeme tak, že buď znovu Excelu řekneme, že záhlaví je skryté, nebo změníme a vrátíme měřítko zobrazení, aby došlo k překreslení. Ach jo.

    Příprava oblasti listu pro export
    Příprava oblasti listu pro export

    V tabulce (víko notebooku) je použita funkce RANDBETWEEN, jejíž výsledky se změní pro přepočtu listu (F9). Oblast pro export je ohraničena buňka A1 a K26 (vpravo dole) a je totožná s viditelnou oblastí. Okamžikem pro uložení je událost Workbook_BeforeSave.

    Modul ThisWorkbook:

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

        'aktualizace výřezu na Plochu při ukládání souboru
        Call KopieVyberuNaPlochu

    End Sub

    Private Sub Workbook_Open()

        'ošetřeni bugu
        'správné usazení obrázku na pozadí při skrytém záhlaví
        'i když už skryté bylo...
        ActiveWindow.DisplayHeadings = False
       
    End Sub

    Standardní modul:

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    Sub KopieVyberuNaPlochu()

        Dim strPozadi As String

        strPozadi = ThisWorkbook.Path & "\excel_pozadi.bmp"
       
        On Error GoTo Konec

        'kopie oblasti jako obrázek do schránky
        'může být i jiný výběr než tabulka (obecně Selection)
        Worksheets(1).Range("A1:K26").CopyPicture xlScreen, xlBitmap

        'převzetí ze schránky
        hBitmap = GetClipBoard

        'transformace formátu
        Set hPix = BitmapToPicture(hBitmap)

        'uložení (vždy bitmapa)
        SavePicture hPix, strPozadi

        'odstranění objektu
        apiDeleteObject (hBitmap)

        'uložení na pozadí
        SystemParametersInfo SPI_SETDESKWALLPAPER, 0, ByVal strPozadi, _
            SPIF_UPDATEINIFILE
           
        Exit Sub
           
    Konec:

        MsgBox "Uložení se nezdařilo, opakujte akci.", vbExclamation + vbOKOnly

    End Sub

    Procedura KopieVyberuNaPlochu obsahuje poněkud ledabylé ošetření jakéhosi chybového stavu. Nahodile (cca jednou z dvaceti pokusů) se mi stávalo, že zkrátka nedoběhla v pořádku. Stačilo přitom spustit ji znovu, a tak jsem po příčině dále nepátral. Uložený obrázek je typu BMP velikosti cca 1,5 MB, i když by byl v našem případě vhodnější JPG (fotografie na pozadí), v ostatních potom PNG nebo i zastaralý GIF. Protáhnout ale formáty JPG/GIF celým procesem není dost dobře realizovatelné, u PNG prakticky nemožné. O samotné uložení se postará další API funkce.

    Tabulka jako pozadí na Ploše
    Tabulka jako pozadí na Ploše

    Drobnou vadou na kráse je fakt, že je obrázek jakoby o 1 px posunutý/oříznutý (vlevo viditelná svislá bílá linka).

    Nezobrazuje se vám obrázek na pozadí ve Windows (8.1)? V rámci Ovládacích panelů a usnadnění nesmí být zatržena volba Odebrat snímky pozadí.

    Když se ve Windows nezobrazuje pozadí na Ploše...
    Když se ve Windows nezobrazuje pozadí na Ploše…

    Windows obsahují bohužel ještě jeden bug, kdy po hrátkách se zobrazením ikon na Ploše může pozadí zčernat. Pokud je mi známo, není jiné cesty, než v takovém případě restartovat Průzkumníka (Explorer.exe).

    V příkladu ukládáme výřez buněk na Plochu počítače, v němž je sešit uložen, nicméně při použití WMI (s administrátorským oprávněním) pod VBA bychom pravděpodobně dokázali ovládat i Plochy dalších počítačů v síti. Nápomocen by nám mohl být i PowerShell.

    Příloha:
    excel_vyber_jako_obrazek.zip

    Uložit článek jako PDF