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

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

此代码片段非常适合复制/粘贴所需的图像。 但是，图像将粘贴到活动工作表的单元格 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