我复制一个范围并作为图片粘贴到PowerPoint幻灯片。
我想复制两个范围并粘贴为图片。
1.范围在下面的代码中。工作。
1.范围为单个单元格(B1)
如何将多个范围(如图片)添加到幻灯片?
Dim PP As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation
Dim PPslide As Object
Dim PpShape As PowerPoint.Shape
Dim SlideTitle As String
Dim SlideNum As Integer
Dim WSrow As Long
Dim Sh As Shape
Dim Rng As Range
Dim myShape As Object
'Open PowerPoint and create new presentation
Set PP = GetObject(class, "PowerPoint.Application")
PP.Visible = True
Set PPpres = PP.Presentations.Open(Filename:="C:\Users\Mac\Desktop\test\PPT.pptx")
'Specify the chart to copy and copy it
For i = 6 To Cells(70, Columns.Count).End(xlToLeft).Column Step 10
With Cells(70, i)
.Resize(1, 10).CopyPicture Appearance:=xlPrinter, Format:=xlPicture
DoEvents
DoEvents
.Offset(15, 0).PasteSpecial
Range("B1").CopyPicture Appearance:=xlPrinter, Format:=xlPicture
DoEvents
DoEvents
.Offset(25, 0).PasteSpecial
End With
'Give the last pasted picture a name.
ActiveSheet.Pictures(ActiveSheet.Pictures.Count).Name = "Chart" & k
'Increase the count for naming pictures by 1
k = k + 1
Set PPslide = PPpres.Slides.Add(1, 10)
PP.ActiveWindow.View.GotoSlide (1)
Set PPslide = PPpres.Slides(1)
'Paste to PowerPoint and position
PPslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = PPslide.Shapes(PPslide.Shapes.Count)
'Set position:
myShape.Left = 20
myShape.Top = 180
myShape.Height = 250
myShape.Width = 950
'Make PowerPoint Visible and Active
PP.Visible = True
PP.Activate
'Clear The Clipboard
Application.CutCopyMode = False
Next i
1条答案
按热度按时间g6ll5ycj1#
函数
.CopyPicture
不能在多个没有相互连接的范围上工作-尝试它会返回错误消息:运行时错误1004:此操作对多个选择无效
因此,您需要为单独的Range(B1)执行单独的
.CopyPicture
,可能类似于(详细信息取决于您正在尝试做的事情):如果希望多个范围只返回一个图像,则可能必须在单独的步骤中合并结果图像。