我希望将存储在剪贴板中的图像放置到 excel spreadhseet 上的特定位置

Question

我正在使用 Microsoft 项目作为图像源，并希望粘贴到 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

此代码段在 copying/pasting 所需图像中完美运行。但是，图像会粘贴到活动工作表的单元格 A1 中。我希望左上角位于单元格 A3 中。如何才能做到这一点？我已经研究过网络，但找不到使用 EditCopy 的图像示例提前致谢。

Answer 1

请这样试试：

 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

Answer 2

花了一些额外的时间进行试验并进行了更多研究，发现可以将范围命令添加到粘贴操作的末尾。

适合我的最终代码是：

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

我希望将存储在剪贴板中的图像放置到 excel spreadhseet 上的特定位置

I wish to place an image stored in the clipboard to a specific location on an excel spreadhseet

excel

vba

ms-project