ThisWorkbook.Sheets("零件数据库").Pictures.Paste(Link:=False).Select 上出现错误 1004

Question

有时我会在线路时出现错误/中断

ThisWorkbook.Sheets("PD").Pictures.Paste(Link:=False).Select

已执行。

代码第一次运行第一遍时，有时会出现错误。
第二次运行循环时，我总是收到错误。
第三次我想一般都会过去了

我收到错误 1004 并且该行在调试器中突出显示，但如果我关闭错误消息框，不进行任何更改并单击“播放”按钮，代码将继续运行，不会再出现任何错误。

Function SaveRangeAsPicture(ImgName As String)

Call UnprotectAll

'PURPOSE: Save a selected cell range as a JPG file to computer's desktop
'SOURCE: www.thespreadsheetguru.com

Dim cht As ChartObject
Dim ActiveShape As Shape

ThisWorkbook.Sheets("Part Database").Select

ThisWorkbook.Sheets("Part Database").Shapes.Range(Array(ImgName)).Select

'Copy/Paste Cell Range as a Picture ***(THIS IS WHERE ERROR OCCURS, 2ND LINE DOWN)***
  Selection.Copy
  ThisWorkbook.Sheets("Part Database").Pictures.Paste(link:=False).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
  
'Create a temporary chart object (same size as shape)
  Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=ActiveShape.Width, _
    Top:=ActiveCell.Top, _
    Height:=ActiveShape.Height)

'Format temporary chart to have a transparent background
  cht.ShapeRange.Fill.Visible = msoFalse
  cht.ShapeRange.Line.Visible = msoFalse
    
'Copy/Paste Shape inside temporary chart
  ActiveShape.Copy
  cht.Activate
  ActiveChart.Paste
  
'Save chart to User's Desktop as JPG File
  cht.Chart.Export "C:\Users\" & Environ("Username") & "\Desktop\" & ActiveShape.Name & ".jpg"

'Replace the Picture on the Userform With the one from the part database

 Call Add_Dynamic_Image2(ActiveShape.Name)
 
'Delete temporary Chart
cht.Delete
  
'Delete temporary image file on desktop
Kill ("C:\Users\" & Environ("Username") & "\Desktop\" & ActiveShape.Name & ".jpg")
  
'Delete Active Shape
ActiveShape.Delete

End Function

我尝试过的事情：

• 确保传递给函数的变量（ImgName）是正确的。
• 将

  DoEvents

  放在各个地方。
• 以各种方式写出发生错误的行。
• 检查物理图像对象的名称是否与变量 ImgName 匹配。

这部分代码的目的不是将电子表格中的图片复制并粘贴到另一个电子表格中，而是将图片作为 .jpg 文件临时保存在用户 PC 上的某个位置，以便我可以动态更改图片在用户窗体上并将 Userform.Image1.Picture 设置为临时文件。

然后它会删除桌面上的 .jpg 并清除我用来创建 .jpg 的 Excel 工作簿中的图表。

Answer 1

函数不是用来复制粘贴的，只是用来计算的。

您可以复制并粘贴已命名的图片。 当你粘贴图片时，它就变成了选中的图片

    Sub CopyPic()

ThisWorkbook.Sheets("Part Database").Shapes("PictureName").Copy
Range("F16").PasteSpecial
 With Selection
 .Name = "NewPic"
 .Left = Range("F16").Left
 .Top = Range("F16").Top
 End With
    
    
End Sub

如果您有一个带有指定图片的活动单元格，则可以使用以下代码。

    Sub SubCopyNamedPic()

ThisWorkbook.Sheets("Part Database").Shapes(ActiveCell.Value).Copy
Range("F16").PasteSpecial
 With Selection
 .Name = "NewPic"
 .Left = Range("F16").Left
 .Top = Range("F16").Top
 End With
    
    
End Sub

Answer 2

我的一个理论是，Excel 可能有点超前，在将图片复制到内存之前尝试粘贴图像。

我添加了 1 秒的等待时间，并且不再遇到任何问题。

但是...我特别不喜欢使用等待功能，因为也许其他用户的电脑速度慢得多，需要更长的等待时间或其他什么。

所以我将在下面发布“有效”的代码，但我仍然有兴趣看看是否有人可以建议一个不依赖于 .select 和 .application.wait 的解决方案：

Sub SaveRangeAsPicture(ImgName As String)

Call UnprotectAll

'PURPOSE: Save a selected cell range as a JPG file to computer's desktop
'SOURCE: www.thespreadsheetguru.com

Dim cht As ChartObject
Dim ActiveShape As Shape

ThisWorkbook.Sheets("Part Database").Select

ThisWorkbook.Sheets("Part Database").Shapes.Range(Array(ImgName)).Select
'Set ActiveShape = ThisWorkbook.Sheets("PartDatabase").Shapes.Range(Array(ImgName))

'Copy/Paste Cell Range as a Picture
  Selection.Copy
  Application.Wait (Now + TimeValue("0:00:01"))
  ThisWorkbook.Sheets("Part Database").Pictures.Paste(link:=False).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)

'Create a temporary chart object (same size as shape)
Set cht = ActiveSheet.ChartObjects.Add( _
Left:=ActiveCell.Left, _
Width:=ActiveShape.Width, _
Top:=ActiveCell.Top, _
Height:=ActiveShape.Height)

'Format temporary chart to have a transparent background
cht.ShapeRange.Fill.Visible = msoFalse
cht.ShapeRange.Line.Visible = msoFalse

'Copy/Paste Shape inside temporary chart
ActiveShape.Copy
cht.Activate
ActiveChart.Paste

'Save chart to User's Desktop as JPG File
cht.Chart.Export "C:\Users\" & Environ("Username") & "\Desktop\" & 
ActiveShape.Name & ".jpg"

'Replace the Picture on the Userform With the one from the part database

Call Add_Dynamic_Image2(ActiveShape.Name)

'Delete temporary Chart
 cht.Delete

'Delete temporary image file on desktop
 Kill ("C:\Users\" & Environ("Username") & "\Desktop\" & ActiveShape.Name & ".jpg")

'Delete Active Shape
ActiveShape.Delete

End Sub