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

有关为何可行但不支持DoEvent的理论，或要求提供有关正确代码的建议。

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

还可以与：

将Ch设为ChartObject

'添加

Ch.Chart.Parent.Select

然后

Ch.Chart.Paste

'因为微软。...

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

2 个答案: