VBA - Диапазон до JPG фото

Question

Я пытаюсь получить файл JPG из определенного диапазона в Excel

Я сейчас получаю

1004 Ошибка времени выполнения для метода Range из объекта _Worksheet.

Вот как выглядит мой код:

Sub Export()

Dim ws As Worksheet
Dim Rng As Range
Dim Chrt As Chart

Set ws = ActiveSheet
Set Rng = Range("B2:H11")

ws.Range(Rng).CopyPicture
Set Chrt = Charts.Add

With Chrt
    .Paste
    .Export FileName = "Case.jpg", Filtername:="JPG"
End With

End Sub

Answer 1

Основная ошибка @J_Lard уже упоминалась в его комментарии.

Но я бы использовал ChartObject а не Chart простынь. При этом вы можете определить размер выходных данных вместо получения всей области диаграммы на рисунке.

И при использовании F8 шаг вставки и экспорт будет работать, в то время как в режиме реального времени, ChartObject должен быть активирован.

Sub Export()

 Dim oWs As Worksheet
 Dim oRng As Range
 Dim oChrtO As ChartObject
 Dim lWidth As Long, lHeight As Long

 Set oWs = ActiveSheet
 Set oRng = oWs.Range("B2:H11")

 oRng.CopyPicture xlScreen, xlPicture
 lWidth = oRng.Width
 lHeight = oRng.Height

 Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)

 oChrtO.Activate
 With oChrtO.Chart
  .Paste
  .Export Filename:="Case.jpg", Filtername:="JPG"
 End With

 oChrtO.Delete

End Sub

Если путь не указан, Case.jpg будет сохранен в месте сохранения по умолчанию. Это, вероятно, ваш каталог пользовательских документов C:\Users\YourName\Documents\

Answer 2

Вот как экспортировать по тому же пути, что и книга:

Sub Export()
Dim ws As Worksheet
Dim Rng As Range
Dim Chrt As Chart
Dim ExportPath As String

Set ws = ActiveSheet
Set Rng = ws.Range("B2:H11")
ExportPath = ThisWorkbook.Path & "\Case.jpg"

Set Chrt = ThisWorkbook.Charts.Add
Rng.CopyPicture xlScreen, xlBitmap   

With Chrt
    .Paste
    .Export FileName:=ExportPath, Filtername:="JPG"
End With
End Sub

Answer 3

Мое решение Excel VBA

1. диапазон.Выбрать
2. диапазон.CopyPicture
3. Вставьте это
4. Вырежьте его для сохранения в системном буфере обмена (ключевая точка)
5. создать команду Windows PowerShell в одну строку
6. выполнить PowerShell от Shell

           Sub 巨集1()
        PicDir = ActiveWorkbook.Path & "\"
        PicFile = Format(Now(), "hh-mm") & ".png"
        Sheets("工作表1").Select
        Range("Q1:U10").CopyPicture Appearance:=xlScreen, Format:=xlPicture '複製範圍成圖檔
        ActiveSheet.Paste '要利用這動作-1，才會真的存到 Clipboard
        ActiveSheet.Shapes.Range(Array(Selection.ShapeRange.Name)).Select '選剛貼上的 Shape
        Selection.Cut '要利用這動作-2，才會真的存到 Clipboard
        sPSCmd = "powershell $img = get-clipboard -format image ; $img.Save('" & PicDir & PicFile & "')" '把 Clipboard 內容存成圖檔的 PowerShell
        RetVal = Shell(sPSCmd, 0) '無聲無息的執行
    End Sub

Answer 4

я должен был добавить

Application.Wait(Сейчас + TimeValue("0:00:15"))