请守柔 斑竹帮忙指教一下！

lastwill

发在别的 版 没人回答阿,没办法了 只好发到热心的 守柔 这版了.

求助]如何编程实现excel中的图表贴到ppt中的固定位置

如题。我想将excel中 sheet（2）和 sheet（3）中的图表分别粘贴到 ppt（pp.ppt为调用的模板，放在c盘根目录下）的第3个 和 第10个（左侧）幻灯片中，而且要调整好 位置和大小。见附件。我编了一部分代码在excel中的“生成ppt”按钮中。因为刚接触，对vba的语法还没全掌握，所以没能成功，不知哪位高手能指教一下！！！！

yrB1lJ2z.rar (45.96 KB, 下载次数: 13)

2005-12-1 22:18 上传

点击文件名下载附件
请守柔 斑竹帮忙指教一下！

守柔

PPT我不太熟悉，勉力做了一下，供参考：

以下代码置于EXCEL中

Private Sub CommandButton3_Click()
'运行此代码前请在VBE/工具/引用中勾选对于MICROSOFT POWPERPOINT 11.0(视版本不同) OBJECT LIBRARY
Dim templateFileURl As String, myShape As PowerPoint.Shape
Dim pptApp As PowerPoint.Application, i As Byte
Dim shName As String, IdNumber As Byte
Dim sngLeft As Single, sngTop As Single, sngWidth As Single, sngHeight As Single
templateFileURl = "C:\pp.ppt" '修改模板路径
On Error Resume Next '忽略错误
Set pptApp = GetObject(, "PowerPoint.Application") '取得对PPT的引用
If Err.Number <> 0 Then
Err.Clear '清除错误
Set pptApp = CreateObject("PowerPoint.Application") '创建PPT对象
pptApp.Visible = True
End If
pptApp.Presentations.Open (templateFileURl) '打开PPT
For i = 1 To 2
Select Case i
Case 1
shName = "Sheet2" '目标图表所在工作表
IdNumber = 4 '以下为设置粘贴后图表的尺寸
sngLeft = 120
sngTop = 110
sngWidth = 480
sngHeight = 320
Case 2
shName = "Sheet3"
IdNumber = 11
sngLeft = 120
sngTop = 110
sngWidth = 480
sngHeight = 320
End Select
Sheets(shName).ChartObjects(1).Copy '复制目标图表
With pptApp
.ActivePresentation.Slides(IdNumber).Select '选定指定的幻灯片
.ActiveWindow.ViewType = ppViewSlide '设置幻灯视图
.ActiveWindow.View.Paste '向当前幻灯片粘贴图表
'定义一个SHAPE对象
Set myShape = .ActivePresentation.Slides(IdNumber).Shapes(.ActivePresentation.Slides(IdNumber).Shapes.Count)
With myShape
.LockAspectRatio = msoFalse '不锁定纵横比
.Left = sngLeft
.Top = sngTop
.Width = sngWidth
.Height = sngHeight
End With
.ActiveWindow.ViewType = ppViewNormal
End With
Next
Set pptApp = Nothing
End Sub

ZdEnhdW6.rar (27.62 KB, 下载次数: 17)

2005-12-2 05:55 上传

点击文件名下载附件

[此贴子已经被作者于2005-12-2 5:55:34编辑过]

lastwill

非常感谢！！！ 像我这样刚学vba的菜鸟能碰上 守柔这样的 热心老师 真是幸运啊！！！呵呵