Making code more efficient (1 Viewer)

[Zedster]

I have an access database which produces a multisheet excel workbook with many tables and charts ( > 20). I need to copy each of these into a powerpoint presentation.

I have created a code for one of the tables (see foot of post). But if I have to repeat this for each of the 20, that is a lot of code. I would ideally like to make a function/sub that can be called multiple times from a single line. But my attempt to create a function just to do a small part of what is required (add a slide) is not succeeding. Can anyone advise a solution.

My Function:

Public Function CreatePowerpointSlide(myPresentation As Object, strSlideName As String) As Object

    Dim intSlideCount, x As Integer
    Dim mySlide As Object
    
    'Set myPresentation = PowerPointApp.Presentations.Open(FileName:="R:\Project Management Central Function\Databases\Budgets\wip\test.pptx")
    intSlideCount = myPresentation.Slides.Count
    Set mySlide = myPresentation.Slides.Add((intSlideCount + 1), ppLayoutBlank) '11 = ppLayoutTitleOnly
    
    'make sure no two slides with same name exist
    For x = intSlideCount To 1 Step -1
        If myPresentation.Slides(x).Name = strSlideName Then
            myPresentation.Slides(x).Delete
        End If
    Next x
    mySlide.Name = "Monthly Summary"
    CreatePowerpointSlide = mySlide

End Function

The use of my function in the main code:

Set mySlide = CreatePowerpointSlide(myPresentation, "Monthly Summary")

This returns error 91 "Object Variable or with block variable not set"

The code below is what I am trying to avoid recreating 20+ times in the main routine:

Set rngToCopy = wsht5.Range("A3:O35")
dblRngHeight = rngToCopy.Height
dblRngWidth = rngToCopy.Width

If PowerPointApp Is Nothing Then
    Set PowerPointApp = CreateObject(Class:="PowerPoint.Application")
End If

Set myPresentation = PowerPointApp.Presentations.Open(FileName:="R:\Project Management Central Function\Databases\Budgets\wip\test.pptx")
intSlideCount = myPresentation.Slides.Count
Set mySlide = myPresentation.Slides.Add((intSlideCount + 1), ppLayoutBlank) '11 = ppLayoutTitleOnly

'make sure no two slides with same name exist
For x = intSlideCount To 1 Step -1
    If myPresentation.Slides(x).Name = "Monthly Summary" Then
        myPresentation.Slides(x).Delete
    End If
Next x
mySlide.Name = "Monthly Summary"

'Set tbxTitle = mySlide.Shapes.AddShape(Type:=msoshaperectangle, Left:=10, Top:=10, Width:=800, Height:=25)
'tbxTitle.Name = "Slide title"

Set tbxTitle = mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=30, Top:=10, Width:=800, Height:=25).TextFrame.TextRange
tbxTitle = "Monthly Summary"
'tbxTitle.ShapeRange.Name = "Title"
'cant get naming of a text box to work at all
tbxTitle.Font.Name = "Arial"
tbxTitle.Font.Size = 20
tbxTitle.Font.Color.RGB = RGB(0, 0, 0)
tbxTitle.ParagraphFormat.Alignment = ppAlignCenter

Set tbxLastUpdate = mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=30, Top:=500, Width:=200, Height:=15).TextFrame.TextRange
tbxLastUpdate = "Last Updated: " & FormatDateEastern([Forms]![frmSwitchboard]![MaxOfLastUpdated])
tbxLastUpdate.Font.Name = "Arial"
tbxLastUpdate.Font.Size = 12
tbxLastUpdate.Font.Color.RGB = RGB(0, 0, 0)
tbxLastUpdate.ParagraphFormat.Alignment = ppAlignLeft
        

'rngToCopy.Copy
rngToCopy.CopyPicture xlScreen, xlBitmap
Set myShapeRange = mySlide.Shapes.PasteSpecial(DataType:=1) 'bitmap
dblShapeHeight = myShapeRange.Height 'this is for info only
dblShapeWidth = myShapeRange.Width 'this is for info only
dblAspectRatio = dblRngWidth / dblRngHeight
With myShapeRange
    .Left = 100
    .Top = 50
    .Width = 700
    .Height = .Width / dblAspectRatio
End With

PowerPointApp.Visible = True
PowerPointApp.Activate
myPresentation.Save


strValidatedPath = strPath
strValidatedFilename = "ManagementReport-" & strType & "-" & FormatDateEastern([Forms]![frmSwitchboard]![MaxOfLastUpdated]) & ".pptx"

If FolderExists(strValidatedPath) Then
     If FileExists(strValidatedPath & "\" & strValidatedFilename) Then
        MsgBox "File already exists and will be overwritten"
    End If
    myPresentation.SaveAs strValidatedPath & "\" & strValidatedFilename 'This will overwite what is there without warning as it stands
    MsgBox "Management Powerpoint report created, filename: " & strValidatedFilename & ". Stored in folder: " & strValidatedPath
Else
    MsgBox "Folder provided does not exist"
End If

 

[theDBguy]

Hi. It might be better if you could post a demo file, so we can try to run it and test the code. Just a thought...

 

[Zedster]

Hi. It might be better if you could post a demo file, so we can try to run it and test the code. Just a thought...

That is a good idea, but I don't think it is practical. This is a small part of a procedure with over 1000 lines. The procedure uses DAO to pull data from multiple tables on a SQL Server and creates a 5 sheet Excel workbook to provide a number of tables and charts summarising the data.

I would have to recreate the SQL database in Access, then convert all the QDFs to Access queries.

I think the issue revolves around whether I can pass objects as arguments to functions and then receive them back. I have never done this before I normally pass strings, vars, dbls etc and get similar back. It could be i am doing it wrong, it could be it's not possible.

 

[theDBguy]

That is a good idea, but I don't think it is practical. This is a small part of a procedure with over 1000 lines. The procedure uses DAO to pull data from multiple tables on a SQL Server and creates a 5 sheet Excel workbook to provide a number of tables and charts summarising the data.

I would have to recreate the SQL database in Access, then convert all the QDFs to Access queries.

I think the issue revolves around whether I can pass objects as arguments to functions and then receive them back. I have never done this before I normally pass strings, vars, dbls etc and get similar back. It could be i am doing it wrong, it could be it's not possible.

Hi. It may not be necessary to do all that just to provide a demo file. You can create one simple table with a couple of fields in it, one form, and the function you're trying to create. All we need to be able to do is test your function to help you figure out why it's not working. If your function relies on a PP template, you may have to provide that.

 

[CJ_London]

I think the issue revolves around whether I can pass objects as arguments to functions and then receive them back

yes, you can by passing them as a byRef parameter - which is the default anyway so does not specifically need to be stated

e.g. function doSomething(frm as form, ctl as control, rst as dao.recordset, etc)

so if for example your code contained

ctl.backcolor=vbRed

then the control you passed as a parameter would change its backcolor to red

 

[MajP]

I would first create a Power Point app, then a power point presentation, then a loop to create your slides passing in the presentation. You are recreating the presentation and app each time

This limited demo works. It creates three slides and makes the textboxes. You would now have to do the same for the Excel. Get the appropriate excel worksheet and pass that in to the makeslide procedure as a second argument

Public Sub Main()
  Dim PowerPointApp As Object
  Dim myPresentation As Object
  Dim mySlide As Object
  Dim rs As DAO.Recordset
  Dim strValidatedPath As String
  
  Set rs = CurrentDb.OpenRecordset("tblSlides")
  'create app once
  Set PowerPointApp = GetPowerPointApp
  PowerPointApp.Visible = True
  'create presentation once
  Set myPresentation = GetPresentation(PowerPointApp)
 
  Do While Not rs.EOF
    Set mySlide = CreatePowerpointSlide(myPresentation, rs!slideName)
    'make slide
    MakeSlide mySlide
    rs.MoveNext
  Loop
    'create slide

 
  'end loop
   PowerPointApp.Visible = True
   PowerPointApp.Activate
  ' myPresentation.Save

   myPresentation.SaveAs CurrentProject.Path & "\MonthlyReport" & ".pptx" 'This will overwite what is there without warning as it stands
End Sub

Public Function GetPowerPointApp() As Object
     Set GetPowerPointApp = CreateObject(Class:="PowerPoint.Application")
End Function

Public Function GetPresentation(PowerPointApp As Object) As Object
  Set GetPresentation = PowerPointApp.Presentations.Open(CurrentProject.Path & "\test.pptx")
End Function

Public Function CreatePowerpointSlide(myPresentation As Object, strSlideName As String) As Object

    Dim intSlideCount, x As Integer
    Dim mySlide As Object
    
    intSlideCount = myPresentation.Slides.Count
    Set mySlide = myPresentation.Slides.Add((intSlideCount + 1), 11) '11 = ppLayoutTitleOnly
    
    'make sure no two slides with same name exist
    For x = intSlideCount To 1 Step -1
        If myPresentation.Slides(x).Name = strSlideName Then
            myPresentation.Slides(x).Delete
        End If
    Next x
    mySlide.Name = strSlideName
    Set CreatePowerpointSlide = mySlide
End Function
Public Sub MakeSlide(mySlide As Object)

 Dim tbxTitle As Object
 Dim tbxLastUpdate As Object
 
'Set tbxTitle = mySlide.Shapes.AddShape(Type:=msoshaperectangle, Left:=10, Top:=10, Width:=800, Height:=25)
'tbxTitle.Name = "Slide title"

 Set tbxTitle = mySlide.Shapes.AddTextbox(Orientation:=1, Left:=30, Top:=10, Width:=800, Height:=25).TextFrame.TextRange
 tbxTitle = mySlide.Name
'tbxTitle.ShapeRange.Name = "Title"
'cant get naming of a text box to work at all
 tbxTitle.Font.Name = "Arial"
 tbxTitle.Font.Size = 20
 tbxTitle.Font.Color.RGB = RGB(0, 0, 0)
 tbxTitle.ParagraphFormat.Alignment = 1

 Set tbxLastUpdate = mySlide.Shapes.AddTextbox(Orientation:=1, Left:=30, Top:=500, Width:=200, Height:=15).TextFrame.TextRange
 tbxLastUpdate = "Last Updated: " & Now
 tbxLastUpdate.Font.Name = "Arial"
 tbxLastUpdate.Font.Size = 12
 tbxLastUpdate.Font.Color.RGB = RGB(0, 0, 0)
 tbxLastUpdate.ParagraphFormat.Alignment = 1
End Sub

 

[Zedster]

This limited demo works.

Thanks for that, you have given me a lot of ideas to play with and answered my question regarding is it possible to pass objects as arguments to a function and return objects back.

I will go away and play. I was originally planning to insert the powerpoint code after each object I created. Your code has made me rethink. I will instead create an object variable to hold ranges and charts and then do the entire powerpoint creation at the end. I will also create the functions you suggest as I will be doing this for routines in access that I use to create workbooks.

 

[MajP]

I think the issue revolves around whether I can pass objects as arguments to functions and then receive them back

If you are talking about the original object passed in, I would say almost never you you pass objectX to a function and manipulate it and return the manipulated objects. Objects are passed by reference (even if passed by val it is just a copy of the pointer) so the thing passed in gets manipulated no need to return it.

You would not do this

Public Function SomeFunction (objectX as object) as Object
  'manipulate objectX
  SomeFUnction = manipulatedObjectX
end function

you simply pass to a sub to manipulate it

Public Sub SomeSub(objectX) 
  manipulate objectX
end sub

I noticed you were declaring everything as objects, at first I assumed late binding but you are using powerpoint constants in the procedures. So you are using early binding. If that is the case do not declare anything as objects instead declare them as what they really are (powerpoint.presentation, powerpoint.slide....)

 

[Zedster]

I noticed you were declaring everything as objects, at first I assumed late binding but you are using powerpoint constants in the procedures. So you are using early binding. If that is the case do not declare anything as objects instead declare them as what they really are (powerpoint.presentation, powerpoint.slide....)

I am very much learning about automating powerpoint so much of my coding approaches come from reading articles on the internet (of which there are few compared to access and excel). Most declare as objects and I have just copied. I must be honest I don't like declaring as objects because I don't get intellisense which would help me until I know all the object hierarchy.

I am in the process of creating functions along the lines you propose. I am having one difficulty though. The slides need to follow a corporate layout and I am struggling to get this to happen. Slide 2 in the master template has the layout. My attempts are:

Set pptLayout = myPresentation.Slides(2).CustomLayout
Set myslide = CreatePowerPointSlide(myPresentation, "Monthly Summary") 'uses the function you wrote
mySlide.Layout = pptLayout

But this results in error 13 type mismatch at last line.

I also tried modifying the function to add a third argument for layout, but again I get type mismatch. Prior to splitting into functions this line executed without error.

Any ideas what I am doing wrong?

 

[MajP]

If you are using latebinding (no reference to the ppt library) then those power point constants will not be useable. Also make sure you set option explicit at the top of your code to ensure are variables are declared. It will help in debugging.

https://support.microsoft.com/en-us/help/245115/using-early-binding-and-late-binding-in-automation

 

[Zedster]

If you are using latebinding (no reference to the ppt library) then those power point constants will not be useable. Also make sure you set option explicit at the top of your code to ensure are variables are declared. It will help in debugging.

https://support.microsoft.com/en-us/help/245115/using-early-binding-and-late-binding-in-automation

Thanks for that, I already have "option compare database" and "option explicit" at the top of all modules

I have changed to early binding for all objects apart from textboxes because I couldn't find a textbox object.

It also enabled me to discover the issue with mySlide.Layout which should have been mySlides.CustomLayout.

 

[MajP]

It also enabled me to discover the issue with mySlide.Layout which should have been mySlides.CustomLayout.

Early binding makes development much easier since you have intellisense. Late binding has advantages in portability of the database to other users, since it is not dependant on their versions of references. However, it makes it very hard to build without intellisense. I usually build it with early binding and get it to completely work. Then if I want to make it late binding, I remove the references which will cause it to break. Then I start hitting debug and fix everything on which the code breaks.