图表对象的粘贴方法在 Excel 2016 中未按预期工作

我有一个代码，最近更新到 Excel 2016，显示出一些奇怪的故障。经过大量调试后，我发现其中一个错误是由 Excel 未能正确处理图像引起的。

下面的代码有一个简单的目的，将工作表的已使用部分复制到图像，然后将该图像作为注释插入工作表中。

但是，为了使该函数在 Excel 2016 中正常工作，我需要重复粘贴操作多次，如代码中所示。

该解决方法是实用的，但我相信需要对原因有一定程度的理解，而且我也更喜欢更干净的解决方案。

Public Sub CopySheetToComment(ReferenceSheet As Worksheet, Target As Range)

Dim rng As Range
Dim Sh As Shape

Dim pWidth As Single
Dim PHeight As Single
Dim cmt As Comment

Dim TempPicFile As String
Application.ScreenUpdating = True

' Path temporary file
TempPicFile = Environ("temp") & "\img.png"

' Define and copy relevant area
Set rng = ReferenceSheet.UsedRange
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

pWidth = rng.Width
PHeight = rng.Height

' Paste copied image to chart and then export to file
Dim C As Object
Set C = ReferenceSheet.Parent.Charts.add
Dim Ch As ChartObject
Set Ch = C.ChartObjects.add(Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height)

' Ugly solution that is working in Excel 2016....
Ch.Chart.Paste
DoEvents
Ch.Chart.Paste
DoEvents
Ch.Chart.Paste
Ch.Chart.Export TempPicFile


' Remove chart object
Dim Alerts As Boolean
Alerts = Application.DisplayAlerts
Application.DisplayAlerts = False
C.Delete
Application.DisplayAlerts = Alerts

' Remove old comment
On Error Resume Next
Target.Comment.Delete
On Error GoTo 0

Application.ScreenUpdating = True
' Add comment
Set cmt = Target.AddComment
Target.Comment.Visible = True

' Infoga bild till kommentar
With cmt.Shape
    .Fill.UserPicture TempPicFile
    .Width = pWidth * 1.33333
    .Height = PHeight * 1.33333
End With
'Target.Comment.visible = False

End Sub

为了调用它，这个例子是有效的：

Sub test()

Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("blad2")
CopySheetToComment ws, Range("D8")

End Sub

需要有关为什么此方法有效但 DoEvents 无效的理论，或要求提供正确代码的建议。

更新我的 Excel 版本后遇到类似的问题。这就是我解决它的方法：

Dim pChart As Chart    'will serve as a temporary container for your pic

rng.CopyPicture xlScreen, xlPicture    'using the rng you use in your code here
Set pChrt = Charts.Add
ActiveChart.ChartArea.Clear
With pChrt
    .ChartArea.Parent.Select    'new for Excel 2016
    .Paste
    .Export Filename:=TempPicFile, Filtername:="PNG"    'TempPicFile is what you defined in your code, so path + file name
    .Delete
End With

然后，您可以使用 PNG 并粘贴它，为其指定宽度/高度。 另外，我会设置Application.DisplayAlerts = False在子的开头并将其设置回True就在最后——更快、更少麻烦。