I sh, чтобы поместить изображение, хранящееся в буфере обмена, в указанное c расположение в таблице Excel - PullRequest
Новая
       53

I sh, чтобы поместить изображение, хранящееся в буфере обмена, в указанное c расположение в таблице Excel

0 голосов
/ 24 января 2020

Я использую проект Microsoft в качестве источника изображения и хочу вставить в указанное c местоположение на указанном листе в книге Excel. 

Sub CreateImageAndPaste()

Dim EStart As String, LFin As String
EStart = ActiveProject.StatusDate - 30
LFin = Tsk.Finish + 30

'Create View, filter and table in MS Project and apply           

Application.PaneClose                 
MSProject.CalculateAll              
Application.EditCopyPicture Object:=False, ForPrinter:=0, SelectedRows:=0, FromDate:=EarliestStart, ToDate:=LFin, ScaleOption:=pjCopyPictureShowOptions, MaxImageHeight:=-1#, MaxImageWidth:=-1#, MeasurementUnits:=2

With xlsheet
    .Activate
    .Cells(1, 1) = t
    DoEvents
    .Paste
    DoEvents
End With

Этот фрагмент отлично работает при копировании / вставка нужного изображения. Однако изображение вставляется в ячейку А1 активного рабочего листа. Я бы хотел, чтобы верхний левый был в ячейке А3. Как это может быть сделано? Я исследовал net и не могу найти пример изображения, которое использует EditCopy. Спасибо заранее.

Ответы [ 2 ]

1 голос
/ 24 января 2020

Попробуйте, пожалуйста: 

 With xlsheet
    .Activate
    .Cells(1, 1) = t
    .Paste
    Application.Selection.ShapeRange.item(1).top = .Range("A3").top
    Application.Selection.ShapeRange.item(1).left = .Range("A3").left
 End With
0 голосов
/ 27 января 2020

Потратил дополнительное время на эксперименты и исследования, и обнаружил, что команда диапазона может быть добавлена ​​в конец операции вставки.

Последний код, который работает для меня: 

Application.PaneClose

MSProject.CalculateAll

Application.EditCopyPicture Object:=False, ForPrinter:=0, SelectedRows:=0, FromDate:=EarliestStart, ToDate:=LFin, ScaleOption:=pjCopyPictureShowOptions, MaxImageHeight:=-1#, MaxImageWidth:=-1#, MeasurementUnits:=2

ScreenUpdating = True

Application.DisplayAlerts = False

Set rng = xlsheet.Range("A3")
With xlsheet
    .Cells(1, 1) = "Target Task = " & t
    .Cells(2, 1) = "Iteration " & iteration
    DoEvents
End With

xlsheet.Paste Destination:=rng
Application.DisplayAlerts = True
...