首页 > 代码库 > 20170813pptVBA批量插入图片
20170813pptVBA批量插入图片
Sub AddSldIn() Dim Pre As Presentation Dim NewSld As Slide Set Pre = Application.ActivePresentation Set NewSld = Pre.Slides.Add(Pre.Slides.Count + 1, ppLayoutBlank) Set Pre = Nothing Set NewSld = Nothing End Sub Sub AddTextBox() Dim Pre As Presentation Dim NewSld As Slide Dim Shp As Shape Dim Pos As Long Dim Tr As TextRange Set Pre = Application.ActivePresentation Set NewSld = Pre.Slides(1) With NewSld Set Shp = .Shapes.AddTextBox(msoTextOrientationHorizontal, Pre.PageSetup.SlideWidth / 2, 0, Pre.PageSetup.SlideWidth / 2, Pre.PageSetup.SlideHeight / 6) With Shp .TextFrame.WordWrap = msoTrue With .TextFrame.TextRange With .ParagraphFormat .LineRuleWithin = msoTrue .SpaceWithin = 1 .LineRuleBefore = msoTrue .SpaceBefore = 0.5 .LineRuleAfter = msoTrue .SpaceAfter = 0 End With myText = "水平文本框" + Chr$(CharCode:=13) + "红色加粗" .Text = myText Pos = InStr(myText, Chr(13)) Set Tr = .Characters(Pos + 1, Len(myText) - Pos) With Tr .Font.Size = 36 .Font.Color.RGB = RGB(Red:=255, Green:=51, Blue:=0) End With End With End With End With Set Pre = Nothing Set NewSld = Nothing End Sub Sub InsertPicture() Dim Pre As Presentation Dim NewSld As Slide Dim Shp As Shape Dim FilePath As String Set Pre = Application.ActivePresentation Set NewSld = Pre.Slides(1) Set Shp = NewSld.Shapes.AddPicture(FilePath, msoFalse, msoTrue, 71, -21, 579, 584) Set Pre = Nothing Set NewSld = Nothing Set Shp = Nothing End Sub Function CustomLeft(ByVal Pre As Presentation, ByVal Pos As Long) As Double End Function
20170813pptVBA批量插入图片
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。