Prezentacija napravljena iz Access-a

Code:


Private Sub cmbPrezentacija_Click()
Dim db As Database, rs As Recordset
Dim ppObj As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation



' Definiši postavke baze iz tabele Podaci
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Podaci", dbOpenDynaset)

' Definiši postavke za Power Point
    Set ppObj = New PowerPoint.Application
    Set ppPres = ppObj.Presentations.Add
    
'Definisanje slajdova i povezivanje sa tabelom Podaci
    With ppPres
        With .SlideMaster
             .Background.Fill.ForeColor.RGB = RGB(0, 0, 153)
             
             With .Shapes.AddTextbox(msoTextOrientationHorizontal, 70, 0, 600, 60)
                  With .TextFrame.TextRange
                       .Text = "Title prezentacije"
                       .Font.Bold = msoTrue
                       .Font.Shadow = msoTrue
                       .Font.Size = 32
                       .Font.Color.RGB = RGB(255, 0, 0)
                       .ParagraphFormat.Alignment = ppAlignCenter
                   End With
             End With
             
             With .Shapes.AddTextbox(msoTextOrientationHorizontal, 120, 500, 10, 20)
                  With .TextFrame.TextRange
                       .Text = " "
                       .Font.Bold = msoTrue
                       .Font.Shadow = msoTrue
                       .Font.Size = 18
                       .Font.Color.RGB = RGB(255, 255, 153)
                       .ParagraphFormat.Alignment = ppAlignLeft
                  End With
                       .SetShapesDefaultProperties
             End With
             
             With .Shapes
                        With .AddLabel(msoTextOrientationHorizontal, 13, 100, 120, 20).TextFrame.TextRange
                                .Text = "Label1:"
                                .ParagraphFormat.Alignment = ppAlignRight
                                .Font.Size = 14
                                .Font.Color.RGB = RGB(0, 255, 0)
                                .Font.Underline = msoTrue
                        End With
                        With .AddLabel(msoTextOrientationHorizontal, 13, 172, 120, 20).TextFrame.TextRange
                                .Text = "Label2:"
                                .ParagraphFormat.Alignment = ppAlignRight
                                .Font.Size = 14
                                .Font.Color.RGB = RGB(0, 255, 0)
                                .Font.Underline = msoTrue
                        End With
                     
             End With
        End With
        
        While Not rs.EOF
        
            With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutBlank)
                 
                 
                 With .Shapes.AddTextbox(msoTextOrientationHorizontal, 125, 320, 550, 40)
                        .TextFrame.TextRange.Text = rs.Fields("Textbox1").Value
                        .Name = " Textbox1"
                 End With
                 
                 With .Shapes.AddTextbox(msoTextOrientationHorizontal, 125, 350, 500, 20)
                        .TextFrame.TextRange.Text = rs.Fields("Textbox2").Value
                        .Name = "Textbox2"
                 End With
                 
                 With .Shapes.AddTextbox(msoTextOrientationHorizontal, 125, 380, 500, 20)
                        .TextFrame.TextRange.Text = rs.Fields("Textbox3").Value
                        .Name = "Textbox3"
                 End With
                 
                 With .Shapes.Range(Array("Textbox1", "Textbox2", "Textbox3",)).Group.AnimationSettings
                        .EntryEffect = ppEffectSpiral
                        .AdvanceMode = ppAdvanceOnTime
                        .AdvanceTime = 5
                        .Animate = msoTrue
                 End With
                
            End With
            
            rs.MoveNext
        Wend
     With .Slides.Range.SlideShowTransition
            .EntryEffect = ppEffectFadeSmoothly
            .Speed = ppTransitionSpeedSlow
            .AdvanceOnTime = msoTrue
            .AdvanceTime = 10
     End With
  End With

' Pokretanje prezentacije
    With ppPres.SlideShowSettings
         .AdvanceMode = ppSlideShowUseSlideTimings
         .LoopUntilStopped = msoTrue
         .Run
    End With
        
End Sub