Скопируйте диапазон ячеек в изображение

Question

Я выбираю диапазон, копирую в диаграмму (как рисунок), сохраняю рисунок как .jpg на сетевой диск, затем удаляю объект.

Код работает 95% времени, но иногда зависает на sht.Pictures.Paste.Select.

Говорит 1004, не может вставить.

Option Explicit
Sub RangeToImage()
    Application.OnTime Now + TimeSerial(0, 0, 30), "RangeToImage"
    Dim tmpChart As Chart, n As Long, shCount As Long, sht As Worksheet, sh As Shape
    Dim fileSaveName As Variant, pic As Variant

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Workbooks("G2_Live_Data.xlsm").Activate
    Set sht = Worksheets("DashboardData")
    sht.Range("A1:AE65").Copy

    sht.Pictures.Paste.Select
    Set sh = sht.Shapes(sht.Shapes.Count)
    Set tmpChart = Charts.Add
    tmpChart.ChartArea.Clear
    tmpChart.Name = "PicChart" & (Rnd() * 10000)
    Set tmpChart = tmpChart.Location(Where:=xlLocationAsObject, Name:=sht.Name)
    tmpChart.ChartArea.Width = sh.Width
    tmpChart.ChartArea.Height = sh.Height
    tmpChart.Parent.Border.LineStyle = 0

    sh.Copy
    tmpChart.ChartArea.Select
    tmpChart.Paste

    fileSaveName = "O:\8700_Manufacturing_Engineeri\02_KIM1_G2_DataTracking\G2LiveDashboard.jpg"
    If fileSaveName <> False Then
      tmpChart.Export Filename:=fileSaveName, FilterName:="jpg"
    End If


    sht.Cells(1, 1).Activate
    sht.ChartObjects(sht.ChartObjects.Count).Delete
    sh.Delete
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Answer 1

1. Я добавил 2 секунды ожидания между копированием / вставкой.Пока это работает.Мой лист Excel использует ссылки DDE для сбора данных из производственного ПЛК, поэтому я думаю, что Excel "завис" или не смог вставить пустое изображение из-за объема передачи данных по ссылке DDE.Просто предположение, но пока это работает.Спасибо за помощь.

Параметр Явный

Sub RangeToImage()
Application.OnTime Now + TimeSerial(0, 0, 30), "RangeToImage"
Dim tmpChart As Chart, n As Long, shCount As Long, sht As Worksheet, sh As Shape
Dim fileSaveName As Variant, pic As Variant

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks("G2_Live_Data.xlsm").Activate
Set sht = Worksheets("DashboardData")
sht.Range("A1:AE65").Copy

Application.Wait (Now + TimeValue("0:00:2"))

sht.Pictures.Paste.Select
Set sh = sht.Shapes(sht.Shapes.Count)
Set tmpChart = Charts.Add
tmpChart.ChartArea.Clear
tmpChart.Name = "PicChart" & (Rnd() * 10000)
Set tmpChart = tmpChart.Location(Where:=xlLocationAsObject, Name:=sht.Name)
tmpChart.ChartArea.Width = sh.Width
tmpChart.ChartArea.Height = sh.Height
tmpChart.Parent.Border.LineStyle = 0

sh.Copy
tmpChart.ChartArea.Select
tmpChart.Paste

fileSaveName = "O:\8700_Manufacturing_Engineeri\02_KIM1_G2_DataTracking\G2LiveDashboard.jpg"
If fileSaveName <> False Then
  tmpChart.Export Filename:=fileSaveName, FilterName:="jpg"
End If


sht.Cells(1, 1).Activate
sht.ChartObjects(sht.ChartObjects.Count).Delete
sh.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True

    End Sub