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

我在复制/粘贴之间添加了2秒的等待时间。到目前为止，这是可行的。我的excel工作表正在使用DDE链接从生产PLC收集数据，因此由于从DDE链接传输的数据量很大，我认为excel在“冻结”或无法粘贴空白图像。只是一个猜测，但到目前为止，它仍然有效。谢谢您的帮助。

显式选项

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

代码中出现1004错误。尝试将一系列单元格复制到图片中，然后保存图片

1 个答案: