Экспорт определенного диапазона Excel в виде JPEG через VBA

Question

Я совершенно новый здесь. Я хочу экспортировать определенный диапазон Excel как JPEG, и я использую VBA для этого.

Я также создал код vba, но у меня возникла небольшая проблема: когда я запускаю код, я экспортирую файл jpeg в таблицу Excel, но хочу экспортировать его по определенному пути в проводнике. Может быть, вы можете помочь быть:)

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:\Users\daniel\Desktop\Sales Report\haus.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

Answer 1

Вот исправленная версия вашего макроса, которая просто копирует / вставляет диапазон непосредственно во временную диаграмму для экспорта.

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:\Users\daniel\Desktop\Sales Report\haus.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