Strange Error 1004 Break in line ThisWorkbook.Sheets("Part Database").Pictures.Paste(Link:=False).Select

Question

执行“ThisWorkbook.Sheets("PD").Pictures.Paste(Link:=False).Select”行时，我的代码出现了一个非常奇怪的错误/中断。

奇怪的是这个错误只是偶尔发生？ 代码第一次通过它的第一遍时，有时我得到错误有时不是...... 我第二次运行循环时，总是出错 第三次，我想一般都会过去吧？！

在所有 3 种情况下，如果它确实决定停止，我会收到错误 1004 MsgBox 并且该行在调试器中突出显示，但是如果我关闭错误消息框，什么都不做更改，只需单击播放按钮。代码只是愉快地进行，没有进一步的错误大声笑。

我的完整代码很大，所以我无法全部粘贴，但我希望如果我只是粘贴发生错误的函数，我希望你们中的一个人可以提出一些我没有寻找或尝试过的东西！

线不会错，因为当我在断线后点击播放时，它会起作用吗？

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 匹配，确实如此。

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

如果你有一个带有命名图片的activecell，你可以使用下面的代码。

    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