Automating Powerpoint slides from Excel

[Corleone]

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]

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

Thanks

 

[Domenic]

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]

Thanks for your help - this works perfectly