هل من الممكن إنشاء جدول زمني لخريطة طريق PowerPoint من C#؟

StackOverflow https://stackoverflow.com/questions/3098594

سؤال

أعلم أن PowerPoint لديه واجهة برمجة تطبيقات مثل Excel و Word. هل هناك على أي حال لإنشاء خريطة طريق جدول زمني برمجيًا (لدي قائمة من المعالم والتواريخ من قاعدة بيانات)؟

هل لدى أي شخص أي روابط أو رمز مثال حول كيفية البدء في محاولة لملء قالب خريطة طريق جدول زمني بشكل برمجي في PowerPoint

إليك مثال (ليس رائعًا) على ما أحاول القيام به: http://www.jumpdesign.net/aboutcd/02history/short_history_timeline.jpg

هل كانت مفيدة؟

المحلول

حسنًا ، لا يزال هذا بحاجة إلى مجموعة من العمل ، ولكن نأمل أن يكون ذلك كافياً للبدء.

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
مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top