图表对象的粘贴方法在 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 并像您一样粘贴它，并为其指定一个 width/height。此外，我会在子句的开头设置 Application.DisplayAlerts = False 并在结尾将其设置回 True - 更快更省事。

Answer 2

也适用于：

将 Ch 变暗为 ChartObject

'添加

Ch.Chart.Parent.Select

'然后

Ch.Chart.Paste

'因为微软....

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

Paste method of Chart object not working as expected in Excel 2016

excel

vba

excel-2016