开发者

Is it possible to generate a PowerPoint roadmap timeline from C#?

开发者 https://www.devze.com 2023-01-04 21:59 出处:网络
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)?

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
0

精彩评论

暂无评论...
验证码 换一张
取 消

关注公众号