Метод вставки объекта Chart не работает должным образом в Excel 2016 - PullRequest
Новая
       13

Метод вставки объекта Chart не работает должным образом в Excel 2016

0 голосов
/ 19 декабря 2018

У меня есть код, недавно обновленный до 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, или предложения для правильного кода.

Ответы [ 2 ]

0 голосов
/ 01 августа 2019

Также работает с:

Dim Ch As ChartObject

'добавление

Ch.Chart.Parent.Select

' затем

Ch.Chart.Paste

'потому что Microsoft ....

0 голосов
/ 19 декабря 2018

После обновления моей версии 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 только в конце - быстрее и меньше хлопот.

...