# Automating Powerpoint slides from Excel



## Corleone (Dec 17, 2022)

Hi
I have copied the following code another Excel sheet which automatically generates a Powepoint slide for every worksheet in the file - is there a way of modifying (im assuming the bit that i have bolded below) it so that it just generates the slides for 3 of the tabs in the worksheet?
Sheet8
Sheet9
Sheet10


Thanks
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Sub Copy_Excel_To_PPT()

'Dim ppt_app As New PowerPoint.Application
'Dim ppt_file As PowerPoint.Presentation
'Dim my_slide As PowerPoint.Slide


Dim PPT_App As Object
Dim ppt_file As Object
Dim my_slide As Object
Set PPT_App = CreateObject("PowerPoint.Application")

Set ppt_file = PPT_App.Presentations.Add

Dim sh As Worksheet

*For Each sh In ThisWorkbook.Sheets
    If sh.Name <> "Setting" Then
        Set my_slide = ppt_file.Slides.AddSlide(1, ppt_file.SlideMaster.CustomLayouts(6))

        my_slide.MoveTo (ppt_file.Slides.Count)*

        '''''' Format Slide title
        With my_slide.Shapes.Title
            .TextFrame.TextRange.Text = sh.Name
            .TextFrame.TextRange.Font.Color = RGB(255, 255, 255)
            .Fill.BackColor.RGB = RGB(0, 128, 128)
            .TextEffect.Alignment = msoTextEffectAlignmentCentered
            .TextEffect.FontName = "Arial Rounded MT Bold"
            .Height = 50
        End With

        sh.UsedRange.CopyPicture xlScreen, xlPicture
        my_slide.Shapes.Paste

        ''''''' Resize and reposition the picture
        With my_slide.Shapes(2)
            .LockAspectRatio = msoCTrue
            .Width = ppt_file.PageSetup.SlideWidth - 30

            .top = 0
            If .Height > ppt_file.PageSetup.SlideHeight Then
                .Height = ppt_file.PageSetup.SlideHeight - 120
            End If

            .Left = 0
            If .Width > ppt_file.PageSetup.SlideWidth Then
                .Width = ppt_file.PageSetup.SlideWidth - 30
            End If
            .Left = (ppt_file.PageSetup.SlideWidth - .Width) / 2
            .top = 100

        End With
    End If
Next

End Sub


----------



## Corleone (Dec 17, 2022)

Alternatively - Is there a way of changing it so that that it just runs against the visible worksheets?

Thanks


----------



## Domenic (Dec 17, 2022)

To specify your sheets, try . . .


```
Dim targetSheetNames As Variant
targetSheetNames = Array("Sheet1", "Sheet2", "Sheet3") 'change the sheet names accordingly

Dim currentSheetName As Variant
Dim currentSheet As Object

For Each currentSheetName In targetSheetNames

    Set currentSheet = ThisWorkbook.Sheets(currentSheetName)

    Set my_slide = ppt_file.Slides.AddSlide(1, ppt_file.SlideMaster.CustomLayouts(6))
    
    my_slide.MoveTo (ppt_file.Slides.Count)

    'etc
    '
    '
    
Next currentSheetName
```

Hope this helps!


----------



## Corleone (Dec 21, 2022)

Thanks for your help - this works perfectly


----------

