Excel 2010 uložení jako obrázek pomocí vba

Ten kód ale není celý, zde jen definuješ oblast, kterou chceš převést do obrázku. Vlastní převod pak dělá funkce "exportrangetopicture" a ta tu jaksi chybí (třeba se tam někde nastavuje velikost, nebo co já vím se tam děje...).
Ovšem nápad posílat list Excelu jako obrázek - raději nekomentuji. Nebude lepší a jednodušší exportovat list do PDF? To už umí i samotný Excel (tuším od 2007 výše) a neměl by být problém s velikostí.

A malé poučení pro příště - kód sem dávej jako text (do bloku CODE), ne jako obrázek. Anebo dej odkaz na stránku, odkud jsi to stáhl.

No ono je to zadání od šéfa :)

Fajn. Zadání je od šéfa, kód sem nedáš, tak jak chceš pomoct?

A vůbec - co jsi tím chtěl jako říct? Že export do PDF přes šéfa neprojde? Tak vyměň šéfa, ne? (OK - fór, ale prostě jsem musel ...).
Šéfovi řekni, že lepší kvalita jde jedině přes to PDF.

Sub JPG_tisk()
Dim rng As Excel.Range

'Set rng = Range("A1:O44")
'Find the last used row in a Column: column A in this example
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'MsgBox LastRow
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
'MsgBox LastCol

Set rng = Range("A1", Cells(LastRow, LastCol))

If ExportRangeToPicture(rng, "d:\rreange.png") Then
'MsgBox "ok!"
Else
MsgBox "Didn't work"
End If

End Sub

Pozn. vím že název obsahuje JPG a ukládám to jako PNG, je to z důvodu že při png nedochází ke kompresi, byla to pozdější úprava

Bohužel, musím se opakovat:

Ten kód ale není celý, zde jen definuješ oblast, kterou chceš převést do obrázku. Vlastní převod pak dělá funkce "exportrangetopicture" a ta tu jaksi chybí...

Vezmu to trochu obšírněji:
Funkci ExportRangeToPicture jsem našel zde. Jedná se o trochu složitější příklad, kdy ve vybrané oblasti má autor dotazu ještě několik grafů a exportuje je do jednoho obrázku spolu s tou vybranou oblastí. Pokud tyto grafy pomineme, důležitý je v tom makru řádek:

rRng.CopyPicture xlScreen, xlPicture

CopyPicture je přitom ta důležitá metoda, která z vybrané oblasti udělá obrázek. Má parametry xlScreen a xlPicture. Pokud se podíváš do nápovědy k VBA pro tuto metodu, zjistíš, že první parametr má možnosti:

xlPrinter - The picture is copied as it will look when it's printed.
xlScreen (default) - The picture is copied to resemble its display on the screen as closely as possible

A druhý parametr:

xlBitmap
xlPicture (default)

(význam viz níže)
Takže by to chtělo najít v kódu ten řádek s příkazem CopyPicture a zkusit různé kombinace parametrů.

při otevření obrázku v malování, Windows prohlížeč fotografií nebo Photo Gallery při přiblížení dochází nejspíš ke kompresi a je to docela špatně čitelné. Řešení jsem našel otevřít to např. v IE

Chceš říct, že jeden a tentýž obrázek otevřený v těch třech programech vypadá jinak než v IE? Jakože ty tři ten obrázek zmrší? Nebo naopak IE z nekvalitního obrázku vytáhne víc než ty tři ostatní? Tak to bych rád viděl... Zkus to nějak odchytit a ukázat... Taky přilož ten uložený obrázek PNG.

Každopádně když jsem testoval jak excel převádí na obrázek, tak se zdá, že při zvolení varianty Format:=xlBitmap jsou výsledky lepší než pro Format:=xlPicture - má to o něco větší rozlišení a zřejmě používá antialiasing nebo něco podobného pro vylepšení obrazu.

Format:=xlPicture

Format:=xlBitmap

Máš pravdu, asi jsem po těch hodinách čumění do PC viděl to co není :D

Jak to teda mám udělat ?

edit. Zkoušel jsem to uložit jako PDF, ale PDF oseká tabulku (má velikost A1:O44), ve výsledku tam jsou asi 4 sloupce, což je nežádoucí.

Divné, že by export do PDF osekal tabulku, to se mi ještě fakt nestalo...
Zkus pro jistotu definovat oblast pro tisk (rozumí se tu celou oblast tabulky).

Tohle jsme právě už zkoušel. Zkoušel jsem použit:

Aktivní listy
Výběr (označil jsem tabulku)

u obou byl stejný výsledek, PDF oseká excel vždy po 5 sloupcích.

edit. Rozložení stránek v pdf je podle toho jak je to rozložené v Excelu, stránku (šířku) zabírá 5 sloupců, nastaveno na A4. Lze to přenastavit, aby to ignorovalo rozložení/rozměry A4, tudíž by šírka stránky byla ,,neomezená".

V Rozložení stránky -> Měřítko je defaultně 100%, když ale snížím na 55% a méně tak už to jde vidět tak jak má. Potřeboval bych to ale nejlépe hodit do makra, do funkce Aftersave.

Ok takže na rozložení jsme už teda přišel, teď bych potřeboval kód, který spočítá ve které poslední buňce jsou data, následně to uloží jako PDF.

Ty opravdu VBA nehovíš.
Už jsem tady 2x psal, že ten kód, co jsi sem dal - tedy subroutina JPG_tisk - definuje oblast, kterou chceš převést do obrázku. Copak asi tedy znamenají proměnné LastRow a LastCol?
Ano, jde o poslední obsazený řádek a poslední obsazený sloupec. Po provedení:

Set rng = Range("A1", Cells(LastRow, LastCol))

obsahuje proměnná rng odkaz na celou oblast s daty.

Tady máš ten můj testovací kód, který funguje - jen si pohlídej rozsah co se má exportovat, jestli ti to bere jen pět sloupců a ty tam máš ještě další popsané sloupce, zkontroluj, jestli jsou obsazené i v prvním řádku! Případně si najdi kód, který prohledá celou tabulku a najde ten rozsah lépe...

Sub ObrazekDoSouboru()

    strLocation = "D:\"
    strFileName = "TestExcel.png"    'Here you put the name of your png file
    Dim rng As Excel.Range

'Set rng = Range("A1:O44")  buď použij rozsah napevno
'Find the last used row in a Column: column A in this example
'Nebo si ho nech vyhledat podle poslední obsazené buňky v řádku 1 a poslední buňky ve sloupci A

Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'MsgBox LastRow
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
'MsgBox LastCol

Set rng = Range("A1", Cells(LastRow, LastCol))

    rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
With ActiveSheet.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height)
        .Name = "ChartForExport"
        .Activate
    End With
    ActiveChart.Paste
    ActiveSheet.ChartObjects("ChartForExport").Chart.Export Filename:=strLocation & "\" & strFileName, Filtername:="png"
    ActiveSheet.ChartObjects("ChartForExport").Delete

End Sub

Tu velikost jsem ošetřil tak, že jsem v Excelu nastavit: Tisk -> měřítko -> přizpůsobit všechny sloupce na jednu stránku (všiml jsem si že PDF vychází z toho jak ej to rozložené na tisk)

Btw. PDF se dokáže zjistit velikost (rozsah) kam až sahá ten sešit, ale vychází z toho co bylo změněno/upraveno, čili šéf, tam má předpřipravenou tabulku (ohraničení) až někam do nekonečna, a pdf to bere jako že tam něco je, takže tam do toho vezme i to ohraničení tabulky kde nejsou data.

Podívám se na ten tvůj kód, uvidíme jak to bude fungovat.

Zatím moc díky.

Makro jsem zkusil, funguje dobře, ale kvalita obrázku je velice mizerná. Asi bude opravdu nejlepší přes to PDF.

Uvidím co mi na to řekne šéf, moc děkuju všem a přejí hezký den.

U mě ta kvalita odpovídá nastavená lupy v Excelu (ono to defakto odchytává v kvalitě zobrazení na monitoru). Když to chceš kvalitnější, dej větší lupu:
Lupa 25%

Lupa 100%

Lupa 200%