Understanding current VBA code and Adding Lines and other shapes to PPT Slides with VBA

[BuJay]

I have hundred of charts in an excel. The following code creates a powerpoint and pastes the charts into the powerpoint based on a pattern. For example, there are 37 charts that repeat across many dimensions, for example, Total_Portfolio has 37 charts, then CRA_Portfolio has 37 charts, the Fixed_Portfolio has 37 charts..... and this patter continues.

The code below pastes 4 charts per slide for the first 5 slides and then 3 charts on the next slide, and then 1 chart per slide for the next 14 slides.

So, the pattern is 4,4,4,4,4,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1 and that repeats until all dimensions are reported.

If I wanted to adjust the code so that each dimension has 41 charts and the pattern across the slides needs to be 4,2,3,3,3,2,4,2,4,1,1,1,1,1,1,1,1,1,1,1,1,1,1 and then repeat, how would I adjust the below code?

I am also wondering how to add lines and a title like on the attached image to specific slides using VBA, for example, all slides have the title and title line but only those slides with multiple charts have the crossed lines creating quadrants.


Option Explicit

Sub CopyChartsToPowerPoint()

'// excel variables/objects
Dim wb As Workbook
Dim source_sheet As Worksheet
Dim chart_obj As ChartObject
Dim i As Long, last_row As Long, tracker As Long

'// powerpoint variables/objects
Dim pp_app As PowerPoint.Application
Dim pp_presentation As Presentation
Dim pp_slide As Slide
Dim pp_shape As Object
Dim pp_slider_tracker As Long

Set wb = ThisWorkbook
Set source_sheet = wb.Worksheets("portfolio_charts")
Set pp_app = New PowerPoint.Application
Set pp_presentation = pp_app.Presentations.Add

last_row = source_sheet.Cells(Rows.Count, "A").End(xlUp).Row
pp_slider_tracker = 1

Set pp_slide = pp_presentation.Slides.Add(pp_slider_tracker, ppLayoutBlank)

For i = 1 To last_row

If i Mod 37 = 5 Or i Mod 37 = 9 Or i Mod 37 = 13 Or i Mod 37 = 17 _
Or i Mod 37 = 21 Or (i Mod 37 > 23 And i Mod 37 < 37) Or i Mod 37 = 0 Or (i Mod 37 = 1 And pp_slider_tracker > 1) Then
pp_slider_tracker = pp_slider_tracker + 1
Set pp_slide = pp_presentation.Slides.Add(pp_slider_tracker, ppLayoutBlank)
End If

Set chart_obj = source_sheet.ChartObjects(source_sheet.Cells(i, "A").Value)
chart_obj.Chart.ChartArea.Copy

'Set pp_shape = pp_slide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)
Set pp_shape = pp_slide.Shapes.Paste

Select Case i Mod 37

Case 1, 5, 9, 13, 17
pp_shape.Left = 66
pp_shape.Top = 86

Case 2, 6, 10, 14, 18
pp_shape.Left = 510
pp_shape.Top = 86

Case 3, 7, 11, 15, 19
pp_shape.Left = 66
pp_shape.Top = 296

Case 4, 8, 12, 16, 20
pp_shape.Left = 510
pp_shape.Top = 296

Case 21
pp_shape.Left = 66
pp_shape.Top = 86

Case 22
pp_shape.Left = 510
pp_shape.Top = 86

Case 23
pp_shape.Left = 66
pp_shape.Top = 296

Case 24 To 37, 0
pp_shape.Left = 192
pp_shape.Top = 90
pp_shape.width = 576
pp_shape.height = 360

End Select

Application.Wait (Now + TimeValue("00:00:01"))

Next i

End Sub

 

[BuJay]

Below creates the slides with appropriate charts per slide.

Option Explicit

Sub CopyChartsToPowerPoint()
    
    '// excel variables/objects
    Dim wb As Workbook
    Dim source_sheet As Worksheet
    Dim chart_obj As ChartObject
    Dim i As Long, last_row As Long, tracker As Long
    
    '// powerpoint variables/objects
    Dim pp_app As PowerPoint.Application
    Dim pp_presentation As Presentation
    Dim pp_slide As Slide
    Dim pp_shape As Object
    Dim pp_slider_tracker As Long
    
    Set wb = ThisWorkbook
    Set source_sheet = wb.Worksheets("portfolio_charts")
    
    Set pp_app = New PowerPoint.Application
    Set pp_presentation = pp_app.Presentations.Add
    
    last_row = source_sheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    pp_slider_tracker = 1
    
    Set pp_slide = pp_presentation.Slides.Add(pp_slider_tracker, ppLayoutBlank)
    
    For i = 1 To last_row
        'Stop
        'Debug.Assert i < 36
        
        If (i Mod 41 = 1 And pp_slider_tracker > 1) Or i Mod 41 = 5 Or i Mod 41 = 7 Or i Mod 41 = 10 Or i Mod 41 = 13 Or i Mod 41 = 16 Or i Mod 41 = 18 Or i Mod 41 = 22 Or i Mod 41 = 24 Or _
        (i Mod 41 > 27 Or i Mod 41 = 0) Then
            
            pp_slider_tracker = pp_slider_tracker + 1
            Set pp_slide = pp_presentation.Slides.Add(pp_slider_tracker, ppLayoutBlank)
            
        End If
        
        Set chart_obj = source_sheet.ChartObjects(source_sheet.Cells(i, "A").Value)
        chart_obj.Chart.ChartArea.Copy
                     
        'Set pp_shape = pp_slide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)
        Set pp_shape = pp_slide.Shapes.Paste
        
        Select Case i Mod 41
        
            Case 1, 5, 7, 10, 13, 16, 18, 22, 24
                pp_shape.Left = 66
                pp_shape.Top = 86

            Case 2, 6, 8, 11, 14, 17, 19, 23, 25
                pp_shape.Left = 510
                pp_shape.Top = 86

            Case 3, 9, 12, 15, 20, 26
                pp_shape.Left = 66
                pp_shape.Top = 306

            Case 4, 21, 27
                pp_shape.Left = 510
                pp_shape.Top = 306
                
        End Select
        
        Application.Wait (Now + TimeValue("00:00:01"))
    Next i

End Sub