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

Question

我有一个代码，最近更新到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 的理论，或对正确代码的建议。

Answer 1

更新我的 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- 更快，更少麻烦。

Answer 2

也适用于：

将通道调暗为图表对象

'添加

章节.图表.父项.选择

'那么

图表.粘贴

"因为Microsoft...