Changing code to adjust number of charts on each powerpoint slide VBA

Question

In an excel file, I have hundreds of charts. According to a pattern, the following code makes a powerpoint and pastes the charts into it. There are 37 charts, for instance, that appear repeatedly throughout multiple dimensions. For instance, the Total Portfolio includes 37 charts, followed by the CRA Portfolio with 37 charts, the Fixed Portfolio with 37 charts, and so on.

The code below inserts four charts on each slide for the first five slides, followed by three charts on the following slide, one chart on each slide for the following fourteen 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. How would I modify the following code such that each dimension contains 41 charts and the pattern throughout the slides is 4, 2, 3, 2, 4, 1, 1, 1, 1, 1, 1, 1, 1, and then repeat?

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

I have a code that works assuming a pattern of 37 charts - need to adjust for 41 charts.

narikkadan · Answer 1 · Jan 23, 2023

Try this:

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