Frage

Ich weiß, Powerpoint hat eine API wie Excel und Word. Gibt es trotzdem einen Zeitplan Roadmap zu erzeugen programmatisch (Ich habe eine Liste von Meilensteinen und Daten aus einer Datenbank)?

hat jemand irgendwelche Links oder Beispielcode, wie zu versuchen, um zu beginnen einen Zeitplan Roadmap Vorlage in Powerpoint

programmatisch ausfüllen

Hier ist ein (nicht gut) Beispiel dafür, was ich zu tun versuchen: http: //www.jumpdesign.net/aboutcd/02history/Short_history_timeline.jpg

War es hilfreich?

Lösung

Okay, das muss noch eine Menge Arbeit, aber hoffentlich ist es genug, um Ihnen den Start.

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
Lizenziert unter: CC-BY-SA mit Zuschreibung
Nicht verbunden mit StackOverflow
scroll top