通过vba将特定的excel范围导出为jpeg

Posted 2021-04-08

我是全新的。我想导出一个特定的excel范围作为jpeg，我使用vba。

我也生成了vba代码，但我有一个小问题：当我运行代码时，我在excel表中导出一个jpeg文件，但我想将它导出到资源管理器的特定路径。也许你可以帮忙:)

Option Explicit

Sub Range_To_Image()
  Dim objPict As Object, objChrt As Chart
  Dim rngImage As Range, strFile As String

  On Error GoTo ErrExit

  With Sheets("Tabelle1") 'Tabellenname - Anpassen!

    Set rngImage = .Range("A1:C20")

    rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    .PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False

    Set objPict = .Shapes(.Shapes.Count)

    strFile = "C:UsersdanielDesktopSales Reporthaus.jpg" 'Pfad und Dateiname für das Bild

    objPict.Copy

    Set objChrt = .ChartObjects.Add(1, 1, objPict.Width + 8, objPict.Height + 8).Chart

    objChrt.Paste
    objChrt.Export strFile
    objChrt.Parent.Delete
    objPict.Delete

  End With

  ErrExit:
  Set objPict = Nothing
  Set objChrt = Nothing
  Set rngImage = Nothing
End Sub

答案

这是宏的修改版本，只需将范围直接复制/粘贴到临时图表中即可导出。

Sub Range_To_Image()
  Dim objChrt As Chart
  Dim rngImage As Range
  Dim strFile As String

  On Error GoTo ErrExit

  With Sheets("Tabelle1") 'Tabellenname - Anpassen!

    Set rngImage = .Range("A1:C20")

    rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    strFile = "C:UsersdanielDesktopSales Reporthaus.jpg" 'Pfad und Dateiname für das Bild

    Set objChrt = .ChartObjects.Add(rngImage.Left, rngImage.Top, rngImage.Width, rngImage.Height).Chart

    With objChrt
        .Parent.Activate 'to avoid exporting an empty file
        .ChartArea.Format.Line.Visible = msoFalse 'remove border from chart
        .Paste
        .Export strFile
        .Parent.Delete
    End With

  End With

ErrExit:
  Set objChrt = Nothing
  Set rngImage = Nothing
End Sub