none
Create Powerpoint presentation from Access 2007 RRS feed

  • Question

  • Can anyone tell me where I can find detailed code examples for creating a powerpoint presentation from Access 2007.  I have found one example that is very basic, but it doesn't show how to setup multiple objects on a single slide or how to format the objects (i.e. font, forecolor, backcolor, borders, etc.)  Nor does it show how to setup multiple slides or animations/timings, looping or any of the things that are relatively simple to setup within Powerpoint.  The reason I'm trying to do this is so I can have textboxs on slides that change dynamically along with formats that change based on the value of a particular textbox.  The ultimate goal is for this presentation to run 24/7 without having to stop it and manually make changes.

    Any help would be greatly appreciated.

    Thanks,

    Mike



    mike scott

    Friday, March 1, 2013 2:46 PM

Answers

  • OK. I will give you a simple code to start for adding textbox in ppt from Access.

    Private Sub Test()
    Dim ppObj As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    ' Open up an instance of Powerpoint.
    Set ppObj = New PowerPoint.Application
    Set ppPres = ppObj.Presentations.Add
    With ppPres
        .Slides.Add 1, ppLayoutTitle
        .Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, _
        Left:=100, Top:=100, Width:=200, Height:=50).TextFrame.TextRange.Text = "Test Box"
        
    End With
    
    ppPres.SlideShowSettings.Run
      Exit Sub
    err_cmdOLEPowerPoint:
      MsgBox Err.Number & " " & Err.Description
    End Sub

    Please check the reference for Microsoft PowerPoint 14.0 Object Library before running the code.

    Key methods:

    Slides.AddSlide Method

    AddTextbox Method

    You may have a look at the following links as well:

    Working with PowerPoint Presentations from Access Using Automation
    http://msdn.microsoft.com/en-us/library/office/aa159920(v=office.11).aspx

    How to create sample Visual Basic for Applications code that uses Automation to create a PowerPoint 2000 presentation in Access 2000
    http://support.microsoft.com/default.aspx?scid=kb;en-us;209960

    Good day.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Wednesday, March 6, 2013 10:26 AM
    Moderator

All replies

  • Hi Mike,

    IMHO, I don't think there is already a complete solution for all these requirements. Perhaps you need to bite the bullet and start to learn coding for power point presentation.

    You may start from Getting Started with VBA in PowerPoint 2010. After that, you can have a look at this link: VBA for PowerPoint developers, and go through these examples as you like.  If you encounter any problem, you are welcome to ask questions in the forum.

    Please feel free to let us know if you need any help. 

    Good day.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Tuesday, March 5, 2013 8:55 AM
    Moderator
  • First of all, based on my original question, am I in the correct forum?  I have tried setting this up using Powerpoint and have not had much success.  The only thing that seems to work is an "Add-On" from PresentationPoint called DataPoint.  This allows me to get data from an external source, however, it is limited on its integration with Powerpoint.  For instance, I can link a textbox to data in Access, but I can't use VBA code to change the color of the text base on a certain value.  Other than this, I can't seem to be able to find a way to connect to an external data source or manipulate textbox properties using VBA.

    I have also tried setting this up in Access with some success, however I have to run a timer to check for updates and it is very unstable (crashes a lot).

    I have also tried working with an example in which a Powerpoint presentation is created from within Access.  It seems to run very smoothly, however, the code sample is not very intuitive.  I have worked with this for several days now and can't seem to be able to figure the simplest of tasks, such as adding textboxs that I can format, adding more than one slide, looping the program until I stop it, adding animations, importing images, etc.

    So, based on this, if anyone could give me some direction, I would appreciate it.  The link in the previous post was not very useful.  All I could seem to find was people asking the same questions as me but with no real answers or solutions.

    Thanks again for your help.

    Mike


    mike scott

    Tuesday, March 5, 2013 8:32 PM
  • OK. I will give you a simple code to start for adding textbox in ppt from Access.

    Private Sub Test()
    Dim ppObj As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    ' Open up an instance of Powerpoint.
    Set ppObj = New PowerPoint.Application
    Set ppPres = ppObj.Presentations.Add
    With ppPres
        .Slides.Add 1, ppLayoutTitle
        .Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, _
        Left:=100, Top:=100, Width:=200, Height:=50).TextFrame.TextRange.Text = "Test Box"
        
    End With
    
    ppPres.SlideShowSettings.Run
      Exit Sub
    err_cmdOLEPowerPoint:
      MsgBox Err.Number & " " & Err.Description
    End Sub

    Please check the reference for Microsoft PowerPoint 14.0 Object Library before running the code.

    Key methods:

    Slides.AddSlide Method

    AddTextbox Method

    You may have a look at the following links as well:

    Working with PowerPoint Presentations from Access Using Automation
    http://msdn.microsoft.com/en-us/library/office/aa159920(v=office.11).aspx

    How to create sample Visual Basic for Applications code that uses Automation to create a PowerPoint 2000 presentation in Access 2000
    http://support.microsoft.com/default.aspx?scid=kb;en-us;209960

    Good day.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Wednesday, March 6, 2013 10:26 AM
    Moderator
  • Thank you for your patience.  Unfortunately, I'm still not able to get this to work.  Let me clarify something.  I am using Office(Powerpoint) 2007 and Microsoft PowerPoint 12.0 Object Library.  In line 8 in your example:

        .Slides.Add 1, ppLayoutTitle

    "Add" is not a member of Slides.  I tried using AddSlide and following the hints but all I get is errors such as "expected end of statement" or "expected =".  I have tried the link (and downloaded the example) "OfficeAccess2PowerPointSample".  In fact, this is the example I have been working with for the past week.  I can't figure out how to add another textbox.  For instance, the following code was already in the example:

                    With .Shapes(2)
                        .AnimationSettings.EntryEffect = ppEffectFlyFromBottom
                        .AnimationSettings.AdvanceMode = ppAdvanceOnTime
                        .AnimationSettings.AdvanceTime = 1
                        .TextFrame.TextRange.Text = strSafetyCaption
                        .TextFrame.TextRange.Characters.Font.Color.RGB = RGB(0, 0, 0)
                        .TextFrame.TextRange.Characters.Font.Name = "Ariel"
                        .TextFrame.TextRange.Characters.Font.Size = 16
                        .Top = 450
                        .Left = 50
                        .Width = 625
                        .TextEffect.Alignment = msoTextEffectAlignmentCentered
                    End With

    I made some modifications and it works fine.  However, when I try to add the following:

                    With .Shapes(3)
                        .AnimationSettings.EntryEffect = ppEffectFlyFromRight
                        .AnimationSettings.AdvanceMode = ppAdvanceOnTime
                        .AnimationSettings.AdvanceTime = 2
                        .TextFrame.TextRange.Text = "This is a test..."
                        .Top = 200
                        .Left = 50
                        .Height = 10
                        .Width = 100
                        .TextFrame.TextRange.Characters.Font.Name = "Ariel"
                        .TextFrame.TextRange.Characters.Font.Size = 12
                        .TextFrame.TextRange.Characters.Font.Color.RGB = RGB(255, 0, 0)
                    End With

    Nothing happens.  I don't get any errors but I also don't get any textbox.

    Can you tell me what I'm doing wrong?

    Thanks,

    Mike



    mike scott

    Wednesday, March 6, 2013 3:32 PM
  • Hi Mike, 

    In Presentationobj.Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle) method, the ppLayoutTitle set the layout of the slide. By default, this kind of layout creates two shapes, namely, two content holders for titles. 

    So if you want to add a text to another shape, say Shapes(3) in your last reply, we need to add shape to the Shapes collection first. 

    You can also set the layout to other values. Please have a look at this link:

    PpSlideLayout Enumeration

    I downloaded the OfficeAccess2PowerPointSample, and modify the code as follow:

      With ppPres
            While Not rs.EOF
                With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
                    .Shapes(1).TextFrame.TextRange.Text = "Hi!  Page " & rs.AbsolutePosition + 1
                    .SlideShowTransition.EntryEffect = ppEffectFade
                    .Shapes(1).TextFrame.TextRange.Characters.Font.Size = 50
                    
                    With .Shapes(2).TextFrame.TextRange
                        .Text = CStr(rs.Fields("LastName").Value)
                        .Characters.Font.Color.RGB = RGB(255, 0, 255)
                        .Characters.Font.Shadow = True
                    End With
                    
                    ''''''The code added by me '''''''''''''''''''''
                    ''
                    ''' Using AddTextbox to add a textbox
                    .Shapes.AddTextbox(msoTextOrientationUpward, _
                    AddTextbox method.."
                    
                    
                    ''' Add shape first before setting text frame.
                    .Shapes.AddShape Type:=msoShapeRectangle, _
                                    
                    With .Shapes(4)
                        .AnimationSettings.EntryEffect = ppEffectFlyFromRight
                        .AnimationSettings.AdvanceMode = ppAdvanceOnTime
                        .AnimationSettings.AdvanceTime = 2
                        .TextFrame.TextRange.Text = "This good test.."
                        .TextFrame.TextRange.Characters.Font.Name = "Ariel"
                        .TextFrame.TextRange.Characters.Font.Size = 12
                        .TextFrame.TextRange.Characters.Font.Color.RGB = RGB(255, 0, 0)
                    End With
                    
                End With
                rs.MoveNext
            Wend
        End With

    Notice: If we directly run the code in the original Access2PowerPoint.mdb database, we need to check the library for Office. It is Microsoft Office 14.0 Object Library in my computer with office 2010 installed. 

    Also, I'd like to share experience with you. 

    We can look for method in Object Browser from the View menu of VBE. We browser the method and check the argument in it. If missing some library for the argument, for example, it may give us a message pointing to the library. 

    So, for the code in my second reply, if ppPres is not nothing in the case, you may check the library reference from this way.

    Good day.

    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.


    Thursday, March 7, 2013 6:32 AM
    Moderator
  • Yoya,

    I can see how the ppSlideLayout Enumeration adds a whole new dimension to this.  I know you don't have time to write the program for me and quite honestly, I don't have time to go through this learning curve at this time.  All I'm trying to do is put together say a half dozen or so slides with each slide having its own collection of objects such as textboxes, images, etc.  Apparently, this is more complicated that what I imagined.  If I could figure out a way in Powerpoint VBA to link textboxes to an external data source such as Access tables and queries, that would make things much simpler.  However, after many many hours of searching the web and asking questions in forums about how to do this, I have come up empty.

    If you have any more suggestions, I am more that will to listen and try.

    Thanks for your help,

    Mike


    mike scott

    Thursday, March 7, 2013 6:18 PM
  • Sorry about the late response.

    >> If you have any more suggestions, I am more that will to listen and try.

    You need to bite the bullet. It is not that much difficult as far as I've tried. 

    >>  If I could figure out a way in Powerpoint VBA to link textboxes to an external data source such as Access tables and queries, that would make things much simpler.  

    To "link" the data, we need to read the tables or queries a row at a time and set the value to the textbox. Just as the demo does. 

    You may take a small step to look into the demo. Take it easy.

    Cheers!


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Wednesday, March 13, 2013 11:51 AM
    Moderator
  • Thanks Yoyo,

    I have managed to put together multiple textboxes and images on multiple slides.  It works great except for one thing.  Once the event is triggered and the slideshow is built at runtime, the external data does not refresh.  I have the following statement at the end:

        ppPres.SlideShowSettings.LoopUntilStopped = True
        ppPres.SlideShowSettings.Run

    So far, the only way I have been able to refresh the data is to take out the "LoopUntilStopped" statement and use the form timer to restart the presentation.  However, there is a problem with this.  Yesterday I started the presentation before I left work to see how it would run over night and hopefully update the external data.  I came in this morning to a black screen.  When I was finally able to make my screen active again, I had over 100 instances of Powerpoint open.  I tried adding "ppPres.Close" to the form timer event.  It ran fine for a few minutes but eventually, I got an error with the highlight pointing to that line of code.

    Do you have any suggestions on how to overcome this?

    Thanks,

    Mike


    mike scott

    Friday, March 15, 2013 1:48 PM
  • Hi Mike,

    >>When I was finally able to make my screen active again, I had over 100 instances of Powerpoint open. 

    How many records are there which you want to show on the power point?

    >>It ran fine for a few minutes but eventually, I got an error with the highlight pointing to that line of code.

    Show us the error message, please. You can upload a screenshot if you need.

    Good day.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Monday, March 18, 2013 5:14 AM
    Moderator
  • Yoyo,

    The amount of data is very minimal.  I am getting data from 2 queries.  There is a total of 4 text boxes that gets data from these queries.  1 - Number of days since last recordable incident.  This is calculated in the query using the current date and the date of the last incident.  2 - TCIR (Total Case Incident Rate).  3 - Year End Goal.  These 3 are on 1 slide.  The second slide shows 1 - Safety Tip of the Day.  This is from a query using the criteria "Day(Now())" to get the appropriate record (usually 20 words or less).  2 - I'm showing a bitmap that changes daily using the same criteria( I have bitmap files that are named "Image1.bmp" through "Image31.bmp".  I also use a fixed image on one other slide and that is all the external data that is used.  There is a total of six slides totaling 115 seconds.  I have the timer event on the form set to 115000.  The timer event calls the sub to start the slide show.

    As far as the error, I've only had that happen one time and have not been able to recreate it since.

    Let me know if you need additional information.

    Thanks,

    Mike


    mike scott

    Monday, March 18, 2013 12:54 PM
  • There is a total of six slides totaling 115 seconds.  I have the timer event on the form set to 115000.  The timer event calls the sub to start the slide show.

    As far as the error, I've only had that happen one time and have not been able to recreate it since.

    So I'm still not clear what the timer event do. Where do you create the slides? Do you want to loop the slides every 115 seconds? You may as well show us the code for the timer event.

    Good day.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Tuesday, March 19, 2013 5:56 AM
    Moderator
  • The purpose of the timer function is to restart the slideshow when it completes.  If I set it to loop continuously, the data will not refresh.  It only refreshes when the slideshow is stopped and restarted.  The slides get created in the Sub "Slide1". 

    The Subs are as follows:

    Private Sub Form_Load()
        
          GetData
       
    End Sub

    Private Sub Form_Timer()

        'The event timer is set to 115000

        ppPres.Close
        GetData
       
    End Sub

    Private Sub GetData()
        strSQL = "SELECT * FROM SafetyTips2Query"
        strSQL2 = "SELECT * FROM SafetyDataQuery"

        Set db = CurrentDb
        Set rs = db.OpenRecordset(strSQL)
        Set rs2 = db.OpenRecordset(strSQL2)

        If (Int(rs2!Days) - 1) < 0 Then
            intNumDays = "0"
            Else:
                intNumDays = Int(rs2!Days) - 1
        End If
       
        lngTCIR = rs2!YearToDate
        lngYEG = rs2!Goal
        datTime = Format(Now() + 0.00138889, "h:mm AMPM")
       
        If IsNull(strDailyMessage = DLookup("[SafetyTip1]", "SafetyTips2Query")) = True Then
            strDailyMessage = ""
            intSafetyMessage = 2
            strSafetyMessageCaption = "Electrolux Safety Policy"
            Else:
                strDailyMessage = rs!SafetyTip1
                intSafetyMessage = 1
                strSafetyMessageCaption = "Safety Tip Of The Day"
        End If
       
        strSafetyCaption = "Thank you for working safely every day and keeping those around you" & _
            Chr(13) & "safe as well.  We can reach our goal if we work together!"
           
        strEnvironmentPolicy = "The Environmental Policy was developed" & Chr(13) & _
            "to ensure that we:"

        strImage1 = "P:\SafetyData\SafetyDataDisplay\images\image" & Day(Now()) & ".bmp"
        strImage2 = "P:\SafetyData\SafetyDataDisplay\images\GreenRecycle.bmp"
        strImage3 = "P:\SafetyData\SafetyDataDisplay\images\SafetyPolicy.bmp"
       
        If lngTCIR > lngYEG Then
            strTCIRColor = RGB(255, 0, 0)
            Else
                strTCIRColor = RGB(0, 104, 0)
        End If
       
        Select Case intNumDays
            Case 0 To 49
                strNumDaysColor = RGB(0, 0, 0)
                intShapeStyle = 2
            Case 50 To 119
                strNumDaysColor = RGB(255, 0, 0)
                intShapeStyle = 2
            Case 120 To 560
                strNumDaysColor = RGB(255, 230, 0)
                intShapeStyle = 1
            Case Else
                strNumDaysColor = RGB(0, 104, 0)
                intShapeStyle = 2
        End Select
       
        Randomize    ' Initialize random-number generator.

        intFrameStyle = (Int((7 * Rnd) + 1)) + 21
       
        Slide1

    End Sub

    Private Sub Slide1()
    On Error Resume Next

        Set ppObj = New PowerPoint.Application
        Set ppPres = ppObj.Presentations.Add
           
        With ppPres

            'Begin Slide 2
            With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
                .Shapes(1).TextFrame.TextRange.Text = strSafetyMessageCaption
                .Shapes(1).TextFrame.TextRange.Characters.Font.Name = "Ariel"
                .Shapes(1).TextFrame.TextRange.Characters.Font.Color.RGB = RGB(0, 20, 100)
                .Shapes(1).TextFrame.TextRange.Characters.Font.Size = 16
                .Shapes(1).TextFrame.TextRange.Characters.Font.Bold = True
                .Shapes(1).Top = 20
                .Shapes(1).Height = 75
                .Shapes(1).TextEffect.Alignment = msoTextEffectAlignmentLeft
                .SlideShowTransition.AdvanceOnTime = True
                .SlideShowTransition.AdvanceTime = 15
                With .Shapes(2)
                    .AnimationSettings.EntryEffect = ppEffectFlyFromBottom
                    .AnimationSettings.AdvanceMode = ppAdvanceOnTime
                    .AnimationSettings.AdvanceTime = 1
                    .TextFrame.TextRange.Text = strSafetyCaption
                    .TextFrame.TextRange.Characters.Font.Color.RGB = RGB(0, 0, 0)
                    .TextFrame.TextRange.Characters.Font.Name = "Ariel"
                    .TextFrame.TextRange.Characters.Font.Size = 16
                    .TextFrame.TextRange.Characters.Font.Bold = True
                    .Top = 400
                    .Left = 50
                    .Width = 625
                    .Height = 60
                    .TextEffect.Alignment = msoTextEffectAlignmentCentered
                End With
                If intSafetyMessage = 1 Then
                    .Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=52, Top:=75, _
                        Width:=300, Height:=300).TextFrame.TextRange.Text = strDailyMessage
                    With .Shapes(3).TextFrame.TextRange.Characters
                        .Font.Name = "Ariel"
                        .Font.Size = 16
                        .Font.Bold = True
                        .Font.Color.RGB = RGB(0, 20, 100)
                    End With
                    .Shapes(3).AnimationSettings.EntryEffect = ppEffectZoomIn
                    .Shapes(3).AnimationSettings.AdvanceMode = ppAdvanceOnTime
                    .Shapes(3).AnimationSettings.AdvanceTime = 1
                    .Shapes(3).AnimationSettings.AnimationOrder = 1
                    .Shapes(3).AnimationSettings.TextLevelEffect = ppAnimateByAllLevels
                    .Shapes(3).AnimationSettings.Animate = True
                    Else:
                        .Shapes.AddPicture FileName:=strImage3, linktofile:=msoTrue, _
                            savewithdocument:=msoTrue, Left:=52, Top:=77, Width:=296, Height:=312
                        .Shapes(3).AnimationSettings.EntryEffect = ppEffectZoomIn
                        .Shapes(3).AnimationSettings.AdvanceMode = ppAdvanceOnTime
                        .Shapes(3).AnimationSettings.AdvanceTime = 1
                        .Shapes(3).AnimationSettings.AnimationOrder = 1
                        .Shapes(3).AnimationSettings.TextLevelEffect = ppAnimateByAllLevels
                        .Shapes(3).AnimationSettings.Animate = True
                End If
                .Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=50, Top:=100, _
                    Width:=300, Height:=300).TextFrame.TextRange.Text = ""
                With .Shapes(4)
                    .ShapeStyle = msoLineStylePreset20
                    .Top = 72
                    .Left = 48
                    .Width = 305
                    .Height = 320
                 End With
                 .Shapes.AddPicture FileName:=strImage1, linktofile:=msoTrue, _
                    savewithdocument:=msoTrue, Left:=370, Top:=75, Width:=320, Height:=320
                 .Shapes(5).AnimationSettings.EntryEffect = ppEffectZoomIn
                 .Shapes(5).AnimationSettings.AdvanceMode = ppAdvanceOnTime
                 .Shapes(5).AnimationSettings.AdvanceTime = 1
                 .Shapes(5).AnimationSettings.AnimationOrder = 2
                 .Shapes(5).AnimationSettings.TextLevelEffect = ppAnimateByAllLevels
                 .Shapes(5).AnimationSettings.Animate = True
            End With
            'End Slide 2
            'Begin Slide 1
                'Textbox = Safety First
            With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
                .Shapes(1).TextFrame.TextRange.Text = "Safety First!!!"
                .Shapes(1).TextFrame.TextRange.Characters.Font.Name = "Ariel"
                .Shapes(1).TextFrame.TextRange.Characters.Font.Size = 48
                .Shapes(1).Top = 20
                .Shapes(1).Height = 75
                .Shapes(1).TextEffect.Alignment = msoTextEffectAlignmentCentered
                '.Shapes(1).Fill.BackColor.RGB = RGB(225, 150, 20)
                .Shapes(1).AnimationSettings.EntryEffect = ppEffectFlyFromBottom
                .Shapes(1).AnimationSettings.AdvanceMode = ppAdvanceOnTime
                .Shapes(1).AnimationSettings.AdvanceTime = 1
                .SlideShowTransition.AdvanceOnTime = True
                .SlideShowTransition.AdvanceTime = 15
                'Textbox = Days since last recordable
                With .Shapes(2)
                    .AnimationSettings.EntryEffect = ppEffectFlyFromRight
                    .AnimationSettings.AdvanceMode = ppAdvanceOnTime
                    .AnimationSettings.AdvanceTime = 1
                    .TextEffect.Alignment = msoTextEffectAlignmentCentered
                    .TextFrame.TextRange.Text = intNumDays
                    .TextFrame.TextRange.Characters.Font.Color.RGB = strNumDaysColor
                    .TextFrame.TextRange.Characters.Font.Name = "Ariel"
                    .TextFrame.TextRange.Characters.Font.Size = 127
                    .TextFrame.TextRange.Characters.Font.Bold = True
                    .Top = 100
                    .Left = 200
                    .Width = 330
                    .Height = 300
                    .TextEffect.Alignment = msoTextEffectAlignmentCentered
                End With
                'Textbox - TCIR
                .Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=460, Top:=320, _
                    Width:=100, Height:=60).TextFrame.TextRange.Text = Format(lngTCIR, "0.00")
                With .Shapes(3).TextFrame.TextRange.Characters
                    .Font.Name = "Ariel"
                    .Font.Size = 28
                    .Font.Bold = True
                    .Font.Color.RGB = strTCIRColor
                End With
                .Shapes(3).TextEffect.Alignment = msoTextEffectAlignmentLeft
                With .Shapes(3).AnimationSettings
                    .EntryEffect = ppEffectZoomIn
                    .AdvanceMode = ppAdvanceOnTime
                    .AdvanceTime = 1
                    .AnimationOrder = 3
                    .TextLevelEffect = ppAnimateByAllLevels
                    .Animate = True
                End With
                'Textbox Caption - Year to date TCIR
                .Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=55, Top:=320, _
                    Width:=400, Height:=300).TextFrame.TextRange.Text = "Year To Date TCIR:  "
                With .Shapes(4).TextFrame.TextRange.Characters
                    .Font.Name = "Ariel"
                    .Font.Size = 28
                    .Font.Bold = True
                    .Font.Color.RGB = RGB(0, 0, 0)
                End With
                .Shapes(4).TextEffect.Alignment = msoTextEffectAlignmentRight
                'Textbox - Year End Goal
                .Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=460, Top:=370, _
                    Width:=100, Height:=60).TextFrame.TextRange.Text = Format(lngYEG, "0.00")
                With .Shapes(5).TextFrame.TextRange.Characters
                    .Font.Name = "Ariel"
                    .Font.Size = 28
                    .Font.Bold = True
                    .Font.Color.RGB = RGB(0, 104, 0)
                End With
                .Shapes(5).TextEffect.Alignment = msoTextEffectAlignmentLeft
                With .Shapes(5).AnimationSettings
                    .EntryEffect = ppEffectZoomIn
                    .AdvanceMode = ppAdvanceOnTime
                    .AdvanceTime = 1
                    .AnimationOrder = 4
                    .TextLevelEffect = ppAnimateByAllLevels
                    .Animate = True
                End With
                'Textbox - Current Year End Goal
                .Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=55, Top:=370, _
                    Width:=400, Height:=300).TextFrame.TextRange.Text = Year(Now()) & _
                    " Year End Goal:  "
                With .Shapes(6).TextFrame.TextRange.Characters
                    .Font.Name = "Ariel"
                    .Font.Size = 28
                    .Font.Bold = True
                    .Font.Color.RGB = RGB(0, 0, 0)
                End With
                .Shapes(6).TextEffect.Alignment = msoTextEffectAlignmentRight
                'Textbox = Days with no recordable inuries
                 .Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=215, Top:=250, _
                    Width:=400, Height:=300).TextFrame.TextRange.Text = "Days with no recordable injuries"
                With .Shapes(7).TextFrame.TextRange.Characters
                    .Font.Name = "Ariel"
                    .Font.Size = 18
                    .Font.Bold = True
                    .Font.Color.RGB = RGB(0, 0, 0)
                End With
                'Rectangle
                .Shapes.AddShape Type:=msoShapeRectangle, Left:=190, Top:=115, Width:=340, Height:=180
                With .Shapes(8)
                    .AutoShapeType = msoShapeRoundedRectangle
                    .BackgroundStyle = intShapeStyle
                    .Fill.BackColor.RGB = RGB(255, 255, 0)
                    .ZOrder msoSendToBack
                End With
                .Shapes.AddShape Type:=msoShapeRectangle, Left:=49, Top:=18, Width:=626, Height:=80
                With .Shapes(9)
                    .ShapeStyle = intFrameStyle
                    .ZOrder msoSendToBack
                End With
            End With
            'End Slide 1
        End With
       
        Set ppLayout = ActivePresentation.Slides(2).CustomLayout
        Set ppSlide = ActivePresentation.Slides.AddSlide(2, ppLayout)

        ppPres.SlideShowSettings.LoopUntilStopped = True
        ppPres.SlideShowSettings.Run

        Exit Sub

    End Sub

    I omitted a few slides to save space, but the total time is 115 seconds.  That is why I set the timer fucntion to restart the slideshow after 115000.

    Is there a way for the data to refresh without stopping and restarting the slideshow?

    Thanks,

    Mike


    mike scott

    Tuesday, March 19, 2013 1:57 PM
  • Hi Mike,

         Set ppObj = New PowerPoint.Application
        Set ppPres = ppObj.Presentations.Add
        

    The two lines of code create powerpoint application during each timer. If you intends to create slides in one power point file, please close the application after each timer. Try something like below:

    Dim sFile As String
    sFile = "D:\Test.pptx"
    Dim bFlag As Boolean
    '' Check if the file is existing
    If Not Dir(sFile, vbDirectory) = vbNullString Then
        bFlag = True
    End If
    
    
       Set ppObj = New PowerPoint.Application
       If bFlag = False Then
       Set ppPres = ppObj.Presentations.Add '' If the file is not existing.
       Else
       Set ppPres = ppObj.Presentations.Open(sFile)
       End If

    The whole procedure is as follow:

    Public i As Integer
    Public temp As Integer
    Public ppPres As Object
    Public ppObj As Object
    
    Private Sub Command0_Click()''Stop the timer.
     Me.TimerInterval = 0
     If temp = 1 Then
     ppPres.Save
     ppPres.Close
     ppObj.Quit
     
     Set ppPres = Nothing
     Set ppObj = Nothing
     End If
     
    End Sub
    
    Sub TestAutoPPT()
    temp = 1
    Dim sFile As String
    sFile = "D:\Test.pptx"
    Dim bFlag As Boolean
    '' Check if the file is existing
    If Not Dir(sFile, vbDirectory) = vbNullString Then
        bFlag = True
    End If
    
    
       Set ppObj = New PowerPoint.Application
       If bFlag = False Then
       Set ppPres = ppObj.Presentations.Add
       Else
       Set ppPres = ppObj.Presentations.Open(sFile)
       End If
       
       With ppPres
            With .Slides.Add(ppPres.Slides.Count + 1, ppLayoutTitle)
              .Shapes(1).TextFrame.TextRange.Text = "This is test 1"
                .Shapes(1).TextFrame.TextRange.Characters.Font.Name = "Ariel"
                .Shapes(1).TextFrame.TextRange.Characters.Font.Color.RGB = RGB(0, 20, 100)
                .Shapes(1).TextFrame.TextRange.Characters.Font.Size = 16
                .Shapes(1).TextFrame.TextRange.Characters.Font.Bold = True
                .Shapes(1).Top = 20
                .Shapes(1).Height = 75
                .Shapes(1).TextEffect.Alignment = msoTextEffectAlignmentLeft
                .SlideShowTransition.AdvanceOnTime = True
                .SlideShowTransition.AdvanceTime = 15
                With .Shapes(2)
                    .AnimationSettings.EntryEffect = ppEffectFlyFromBottom
                    .AnimationSettings.AdvanceMode = ppAdvanceOnTime
                    .AnimationSettings.AdvanceTime = 1
                    .TextFrame.TextRange.Text = "this is test two"
                    .TextFrame.TextRange.Characters.Font.Color.RGB = RGB(0, 0, 0)
                    .TextFrame.TextRange.Characters.Font.Name = "Ariel"
                    .TextFrame.TextRange.Characters.Font.Size = 16
                    .TextFrame.TextRange.Characters.Font.Bold = True
                    .Top = 400
                    .Left = 50
                    .Width = 625
                    .Height = 60
                    .TextEffect.Alignment = msoTextEffectAlignmentCentered
                End With
            End With
             With .Slides.Add(ppPres.Slides.Count + 1, ppLayoutTitle)
                With .Shapes(2)
                    .AnimationSettings.EntryEffect = ppEffectFlyFromBottom
                    .AnimationSettings.AdvanceMode = ppAdvanceOnTime
                    .AnimationSettings.AdvanceTime = 1
                    .TextFrame.TextRange.Text = "Good"
                    .TextFrame.TextRange.Characters.Font.Color.RGB = RGB(0, 0, 0)
                    .TextFrame.TextRange.Characters.Font.Name = "Ariel"
                    .TextFrame.TextRange.Characters.Font.Size = 16
                    .TextFrame.TextRange.Characters.Font.Bold = True
                    .Top = 400
                    .Left = 50
                    .Width = 625
                    .Height = 60
                    .TextEffect.Alignment = msoTextEffectAlignmentCentered
                End With
            End With
        End With
        ppPres.SaveAs sFile, ppSaveAsDefault
        ppPres.SlideShowSettings.LoopUntilStopped = True
        
        ppPres.SlideShowSettings.Run
        
       
    End Sub
    
    Private Sub Form_Load()
    temp = 0
    
    End Sub
    
    Private Sub Form_Timer()
    If i < 10 Then
    If temp = 1 Then
     
     ppPres.Close
    End If
    TestAutoPPT
    Else
     Me.TimerInterval = 0
    End If

    Good day. 


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Thursday, March 21, 2013 7:28 AM
    Moderator
  • Yoyo,

    First of all, thank you for all your help and especially your patience.

    I experimented with your code example and didn't have much luck.  I did have to add one line to avert an error - "ppApp.Visible = True".  However, after that, it would open the presentation with the 2 slides and save it.  Then open it again and save it with 2 additional slides for a total of 4. Then open it again and add 2 more for a total of 6, etc.

    As far as the code example I sent to you, it seems to be working OK.  Hopefully, you were able to understand what my objective was for running the presentation "non-stop" and having a few textboxes update each time the slideshow repeated.  It has run for approx 48 hrs without failing.  There are still a few issues I would like to understand and try to figure out.  The way I added all the additional slides may not be the most efficient way, but I will learn that with time.  One thing I would like to overcome is the pause between the end of the slideshow and restarting it again.  I took a screenshot that should show you what I mean.(See below)  As I mentioned in my earlier post, if I let it loop continuously without restarting, I can eliminate this.  However, it I don't restart the presentation each time, the data will not update.  Let me know if you have any suggestions on this.

    Thanks again for all your help.

    Mike


    mike scott

    Thursday, March 21, 2013 1:50 PM
  • The only thing I can think of is to run the code in your last but the second post but each time kill other ppt processes/windows and have only the currently running ppt window. 

    Good day.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Monday, March 25, 2013 3:28 AM
    Moderator