Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Excel 2010 uložení jako obrázek pomocí vba

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

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny