I know PowerPoint has an API like Excel and word. Is there anyway to开发者_开发知识库 generate a timeline roadmap programatically (I have a list of milestones and dates from a database)?
Does anyone have any links or example code on how to get started on trying to programatically fill out a timeline roadmap template in powerpoint
Here's a (not great) example of what I am trying to do: http://www.jumpdesign.net/aboutcd/02history/Short_history_timeline.jpg
Okay, this still needs a bunch of work, but hopefully it is enough to get you started.
Sub GenerateTimeLine()
Dim ap As Presentation
Set ap = ActivePresentation
'Set to first slide
Dim sl As Slide
Set sl = ap.Slides(1)
'Use Slide Master for Presentation dimensions
Dim sm As Master
Set sm = ap.SlideMaster
'Create a timeline body of 75% the width of the slide
Dim w As Integer
w = sm.Width * 0.75
'Create a timeline body of 5% the height of the slide
Dim h As Integer
h = sm.Height * 0.1
'Center horizontal position of timeline body
Dim posX As Integer
posX = Abs(w - sm.Width) / 2
'Center vertical position of timeline body
Dim posY As Integer
posY = Abs(h - sm.Height) / 2
'Add main shape
Dim timeLineBodyShape As Shape
Set timeLineBodyShape = sl.Shapes.AddShape(msoShapeRectangle, posX, posY, w, h)
'Set up initial variables
Dim timeLineBodyName As String
timeLineBodyName = "Showjumping"
Dim yearMin As Integer
Dim yearMax As Integer
yearMin = 1864
yearMax = 2006
'Add to variables timeline
With timeLineBodyShape.TextFrame
With .Ruler.TabStops
.Add ppTabStopLeft, 0
.Add ppTabStopCenter, timeLineBodyShape.Width / 2
.Add ppTabStopRight, timeLineBodyShape.Width
End With
With .TextRange
.InsertAfter CStr(yearMin) + Chr(9) + timeLineBodyName + Chr(9) + CStr(yearMax)
.Font.Bold = msoTrue
End With
End With
'Create time line nodes
Dim timeLineNodeYear As Integer
Dim timeLineNodeText As String
Dim timeLineNodeTop As Boolean
timeLineNodeYear = 1864
timeLineNodeText = "First Competition. Horse Show of the Royal Dublin Society"
timeLineNodeTop = True
AddtimeLineNode timeLineBodyShape, timeLineNodeYear, timeLineNodeText, timeLineNodeTop, _
sl, yearMin, yearMax, sm
timeLineNodeYear = 1912
timeLineNodeText = "Stockholm Olympic Games. Team competition for first time in jumping"
timeLineNodeTop = False
AddtimeLineNode timeLineBodyShape, timeLineNodeYear, timeLineNodeText, timeLineNodeTop, _
sl, yearMin, yearMax, sm
timeLineNodeYear = 1925
timeLineNodeText = "Aachen. For the first time Aachen Grand Prix"
timeLineNodeTop = True
AddtimeLineNode timeLineBodyShape, timeLineNodeYear, timeLineNodeText, timeLineNodeTop, _
sl, yearMin, yearMax, sm
timeLineNodeYear = 1953
timeLineNodeText = "Paris. For first time World Championship for men"
timeLineNodeTop = False
AddtimeLineNode timeLineBodyShape, timeLineNodeYear, timeLineNodeText, timeLineNodeTop, _
sl, yearMin, yearMax, sm
timeLineNodeYear = 1979
timeLineNodeText = "The first Volvo World Cup Final"
timeLineNodeTop = True
AddtimeLineNode timeLineBodyShape, timeLineNodeYear, timeLineNodeText, timeLineNodeTop, _
sl, yearMin, yearMax, sm
timeLineNodeYear = 1990
timeLineNodeText = "Stockholm. The first World Equestrian Games"
timeLineNodeTop = False
AddtimeLineNode timeLineBodyShape, timeLineNodeYear, timeLineNodeText, timeLineNodeTop, _
sl, yearMin, yearMax, sm
timeLineNodeYear = 2006
timeLineNodeText = "Aachen. Biggest World Equestrian Games until now"
timeLineNodeTop = True
AddtimeLineNode timeLineBodyShape, timeLineNodeYear, timeLineNodeText, timeLineNodeTop, _
sl, yearMin, yearMax, sm
End Sub
Sub AddtimeLineNode(tlShape As Shape, tlYear As Integer, tlText As String, tlTop As Boolean, _
sl As Slide, yearMin As Integer, yearMax As Integer, sm As Master)
'Positioning calculations
Dim shapeDifference As Single
shapeDifference = tlShape.Width - tlShape.Left
Dim yearDifference
yearDifference = yearMax - yearMin
Dim timeLineNodeShape As Shape
timeLineNodeShapeWidth = 100
timeLineNodeShapeHeight = 100
timeLineNodeShapePosLeft = (tlShape.Left + (((tlYear - yearMin) / yearDifference) * shapeDifference))
timeLineNodeShapePosTop = 30
If tlTop Then
Set timeLineNodeShape = sl.Shapes.AddShape(msoShapeRectangularCallout, timeLineNodeShapePosLeft, _
timeLineNodeShapePosTop, timeLineNodeShapeWidth, timeLineNodeShapeHeight)
timeLineNodeShapeMid = timeLineNodeShape.Top + timeLineNodeShape.Height / 2
timeLineBodyShapeHeight = tlShape.Height
Distance = tlShape.Top - timeLineNodeShapeMid
handleYplacement = Distance / timeLineNodeShape.Height
timeLineNodeShape.Adjustments(2) = handleYplacement
Else
timeLineNodeShapePosBottom = sm.Height - timeLineNodeShapeHeight - timeLineNodeShapePosTop
Set timeLineNodeShape = sl.Shapes.AddShape(msoShapeRectangularCallout, timeLineNodeShapePosLeft, _
timeLineNodeShapePosBottom, timeLineNodeShapeWidth, timeLineNodeShapeHeight)
timeLineNodeShapeMid = timeLineNodeShape.Top + timeLineNodeShape.Height / 2
timeLineBodyShapeHeight = tlShape.Height
Distance = (tlShape.Top + tlShape.Height) - timeLineNodeShapeMid
handleYplacement = Distance / timeLineNodeShape.Height
timeLineNodeShape.Adjustments(2) = handleYplacement
End If
timeLineNodeShape.TextFrame.TextRange = CStr(tlYear) & ", " & tlText
timeLineNodeShape.TextFrame2.AutoSize = msoAutoSizeTextToFitShape
End Sub
精彩评论