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
