Excel VBA to create Powerpoint File

[Harriers007]

Just wondering if anyone can please help;

I have the following code that works fine, however, it has a fixed range for every excel worksheet.

What I need to be able to do is to select a different range for each worksheet and I can not figure out how to set a range for a named worksheet? any idea's?..... I'd be grateful for anything

Sub ExceltoPowerPoint()
    
'Step 1:  Declare your variables
    Dim pp As Object
    Dim PPPres As Object
    Dim PPSlide As Object
    Dim xlwksht As Worksheet
    Dim MyRange As String
    Dim MyTitle As String
    
'Step 2:  Open PowerPoint, add a new presentation and make visible
    Set pp = CreateObject("PowerPoint.Application")
    Set PPPres = pp.Presentations.Add
    pp.Visible = True
        
'Step 3:  Set the ranges for your data and title
    MyRange = "B2:BH30"  '<<<Change this range
    
'Step 4:  Start the loop through each worksheet
    For Each xlwksht In ActiveWorkbook.Worksheets
    xlwksht.Select
    Application.Wait (Now + TimeValue("0:00:1"))
'Step 5:  Copy the range as picture
    xlwksht.Range(MyRange).CopyPicture _
    Appearance:=xlScreen, Format:=xlPicture
    
'Step 6:  Count slides and add new blank slide as next available slide number
          '(the number 12 represents the enumeration for a Blank Slide)
    SlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
    PPSlide.Select
         
'Step 7:  Paste the picture and adjust its position
    PPSlide.Shapes.Paste.Select
    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pp.ActiveWindow.Selection.ShapeRange.Top = 1
    pp.ActiveWindow.Selection.ShapeRange.Left = 1
    pp.ActiveWindow.Selection.ShapeRange.Width = 960 '700
     
'Step 8:  Add the title to the slide then move to next worksheet
    Next xlwksht
            
'Step 9:  Memory Cleanup
    pp.Activate
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set pp = Nothing
               
End Sub

 

[mole999]

this will help explain how to find the last row > https://www.excelcampus.com/vba/find-last-row-column-cell/

if you get stuck, come back

 

[Harriers007]

Below is the correct code that I am trying to amend so that I can select a different range for each named worksheet;

Sub ExceltoPowerPoint()
    
'Step 1:  Declare your variables
    Dim pp As Object
    Dim PPPres As Object
    Dim PPSlide As Object
    Dim xlwksht As Worksheet
    Dim MyRange As String
    Dim MyTitle As String
    
'Step 2:  Open PowerPoint, add a new presentation and make visible
    Set pp = CreateObject("PowerPoint.Application")
    Set PPPres = pp.Presentations.Add
    pp.Visible = True
        
'Step 3:  Set the ranges for your data and title
    MyRange = "B2:BH30"  '<<<change this="" range
    
'Step 4:  Start the loop through each worksheet
    For Each xlwksht In ActiveWorkbook.Worksheets
    xlwksht.Select
    Application.Wait (Now + TimeValue("0:00:1"))
'Step 5:  Copy the range as picture
    xlwksht.Range(MyRange).CopyPicture _
    Appearance:=xlScreen, Format:=xlPicture
    
'Step 6:  Count slides and add new blank slide as next available slide number
          '(the number 12 represents the enumeration for a Blank Slide)
    SlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
    PPSlide.Select
         
'Step 7:  Paste the picture and adjust its position
    PPSlide.Shapes.Paste.Select
    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pp.ActiveWindow.Selection.ShapeRange.Top = 1
    pp.ActiveWindow.Selection.ShapeRange.Left = 1
    pp.ActiveWindow.Selection.ShapeRange.Width = 960 '700
     
'Step 8:  Add the title to the slide then move to next worksheet
    Next xlwksht
            
'Step 9:  Memory Cleanup
    pp.Activate
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set pp = Nothing
               
End Sub

</change>

 

[Harriers007]

Not sure why it hasn't shown all the VB code but lets try again;

All I want to do is to be able to amend the code below (which works fine) so that I can select a different range for the various sheets that are within the workbook, approx. 10. Currently the code below fixes the range for all the worksheets.

Sub WorkbooktoPowerPoint()

'Step 1: Declare your variables
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim xlwksht As Worksheet
Dim MyRange As String
Dim MyTitle As String

'Step 2: Open PowerPoint, add a new presentation and make visible
Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Add
pp.Visible = True

'Step 3: Set the ranges for your data and title
MyRange = "B2:BH40" '<<
<change this="" range
'Step 4: Start the loop through each worksheet
For Each xlwksht In ActiveWorkbook.Worksheets
xlwksht.Select
Application.Wait (Now + TimeValue("0:00:1"))
'Step 5: Copy the range as picture
xlwksht.Range(MyRange).CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

'Step 6: Count slides and add new blank slide as next available slide number
'(the number 12 represents the enumeration for a Blank Slide)
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
PPSlide.Select

'Step 7: Paste the picture and adjust its position
PPSlide.Shapes.Paste.Select
pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
pp.ActiveWindow.Selection.ShapeRange.Top = 1
pp.ActiveWindow.Selection.ShapeRange.Left = 1
pp.ActiveWindow.Selection.ShapeRange.Width = 700

'Step 8: Add the title to the slide then move to next worksheet
Next xlwksht

'Step 9: Memory Cleanup
pp.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing

End Sub

Thanks for any help</change>

 

[starl]

I don't know why, but the code tags were causing the window to cut your code off, so I removed the tags.

 

[mole999]

Step three double Less Than I Guess

 

[starl]

Step three double Less Than I Guess

hey mole - I forgot, when trying to fix the thread, i removed some code.. i just put it back. it's that double less than in step 3....