在EXCEL中用VBA如何打开PPT并增幻灯片

mawei2 · 发表于 2018-4-6 16:07

在EXCEL中打开ppt,并新增一个幻灯片
这个增加幻灯片的代码，怎么都不对。用的是office2007 excel ,代码是写在excel里的，哪们大侠解答一下
代码如下
Sub test()
Dim path As String
Dim outputFileName As String
outputFileName = "test1.pptx"
Set pptApp = CreateObject("powerpoint.application")
pptApp.Visible = msoTrue
Set pptOutput = pptApp.Presentations.Open(ThisWorkbook.path & "\" & outputFileName)

Set newSlide = .Presentations.Slides.Addslide(1, ppLayoutBlank)‘这里不知道如何写，一直不对。
End With

end sub

duquancai · 发表于 2018-4-6 16:13

好写吧！

mawei2 · 发表于 2018-4-6 16:21

duquancai 发表于 2018-4-6 16:13
好写吧！

请指导一下，我那红色的那句一直不知道如何写啊，一直提示不对

duquancai · 发表于 2018-4-6 17:19

本帖最后由 duquancai 于 2018-4-6 18:30 编辑

Sub test()
Dim pptApp As Object, pptOutput As Object, pptLayout As Object, newSlide As Object
Dim outputFileName As String, path As String, n&
outputFileName = "test1.pptx"
Set pptApp = CreateObject("powerpoint.application")
pptApp.Visible = -1
Set pptOutput = pptApp.Presentations.Open(ThisWorkbook.path & "\" & outputFileName, -1, -1, -1)
If pptOutput.Slides.Count > 0 Then
      n = pptOutput.Slides.Count
      Set pptLayout = pptOutput.Slides(1).CustomLayout
      Set newSlide = pptOutput.Slides.Addslide(n + 1, pptLayout)
Else
      Set newSlide = pptOutput.Slides.Add(1, 12)
      Set pptLayout = pptOutput.Slides(1).CustomLayout
      Set newSlide = pptOutput.Slides.Addslide(2, pptLayout)
End If
End Sub

mawei2 · 发表于 2018-4-6 20:29

无比感谢。

qishimj88 · 发表于 2019-10-20 14:27

大哥，你好，我最近再学习PPT VSA，实在是没找到学习资料，您有吗？可以给我自学一下吗？万分感谢

ning84 · 发表于 2022-11-5 22:47

Sub ll2()
Dim PptApp As PowerPoint.Application
Dim PptPresent As PowerPoint.Presentation
Dim PptSlide As PowerPoint.Slide
Dim StrTemp As String
Set PptApp = New PowerPoint.Application
Set PptPresent = PptApp.Presentations.Add(msoTrue)
PptApp.Visible = True
Set PptSlide = PptPresent.Slides.Add(Index:=1, Layout:=ppLayoutTitle)
Debug.Print PptSlide.Name
'ActiveWindow.Selection.SlideRange.Shapes.AddPicture(Filename:="D:\日出日落\高德地图\2022年9月26日联安路\IMG_20220926_091814303.jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=-119, Top:=-369, Width:=960, Height:=1280).Select
Dim Pict 'As Shape
Set PptSlide = PptPresent.Slides.Add(Index:=2, Layout:=ppLayoutTitle)
Stop
Debug.Print PptSlide.Name
Set Pict = PptSlide.Shapes.AddPicture(Filename:="D:\日出日落\高德地图\2022年9月26日联安路\IMG_20220926_091814303.jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=-119, Top:=-369, Width:=960, Height:=1280)
With Pict
Debug.Print .Name, .Left, .Top, .Type
End With
Stop
Stop
Set PptSlide = PptPresent.Slides.Add(Index:=1, Layout:=ppLayoutTitle)
Debug.Print PptSlide.Name
Set PptSlide = PptPresent.Slides.Add(Index:=2, Layout:=ppLayoutTitle)
Debug.Print PptSlide.Name
Stop
PptPresent.Close
PptApp.Quit
Stop
End Sub

复制代码

ning84 · 发表于 2023-1-26 10:38

duquancai 发表于 2018-4-6 17:19
Sub test()
Dim pptApp As Object, pptOutput As Object, pptLayout As Object, newSlide As Object
...

自学，没有人教授VBA,用Object根本没办法编程序。准确定义dim编程更方便。

Sub ll()
Dim Ppt As PowerPoint.Application
Dim Pres As Presentation
Dim Sld As Slide
Dim SldRng As SlideRange
Dim ShpRng As ShapeRange
Set Pres = Application.ActivePresentation
Set Ppt = New PowerPoint.Application
Debug.Print Ppt.Name, Ppt.Path
Debug.Print Pres.FullName
Set Sld = Pres.Slides(5)
Sld.Select
Debug.Print Sld.Name
'Set SldRng = Ppt.ActiveWindow.Selection.SlideRange
Set SldRng = Pres.Slides.Range(2)
With SldRng
.FollowMasterBackground = msoFalse
.DisplayMasterShapes = msoTrue
With .Background
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(200, 200, 100)
.Fill.Transparency = 0#
.Fill.Solid
End With
End With
Debug.Print SldRng.Name
'SldRng.Background.Fill.ForeColor.RGB = 16777200
End Sub

复制代码

ning84 · 发表于 2023-2-5 07:36

添加新的空白Slide关键语句。
.Slides.Add(Pres.Slides.Count + 1, ppLayoutBlank)

Function PptTable(Sld As Slide, Arr, FontSize, Rr, Cc, Left, Top, Width, RowHeight, ColWidth)
Dim Shp ' As Shape
Set Shp = Sld.Shapes.AddTable(Rr, Cc, 20, 10, 400)
For ii = 1 To Rr
For jj = 1 To Cc
With Shp.Table.Cell(ii, jj).Shape.TextFrame.TextRange
.Text = "行" & ii & ",列" & jj
.Font.Size = FontSize
End With
Shp.Table.Columns.Item(jj).Width = ColWidth
Next jj
Shp.Table.Rows.Item(ii).Height = RowHeight
Next ii
Set PptTable = Shp.Table
End Function
''
Private Sub del25()
Dim Ppt As PowerPoint.Application
Dim Pres As Presentation
Dim Sld As Slide
Dim oTab As Table
Dim Arr
Set Ppt = New PowerPoint.Application
Ppt.Visible = msoCTrue
Set Pres = Ppt.Presentations.Add
'Set Sld = Pres.Slides.AddSlide(1, Layout:=ppLayoutTex)
Set Sld = Pres.Slides.Add(Pres.Slides.Count + 1, ppLayoutBlank)
Set oTab = PptTable(Sld, Arr, 10, 10, 3, 0, 0, 3, 3, 150)
Stop
Ppt.Quit
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 在EXCEL中用VBA如何打开PPT并增幻灯片

评分