Need to Export Excel sheet range to Multiple Powerpoint Slides

[eresylva]

Hello Comrades,

I am new to Excel VBA so please excuse any misuse of excel terminologies. I used some code I found on a Youtube tutorial video to export from excel to PowerPoint using VBA. The code worked to an extent until I tried to modify it - now I'm stuck.


I want to export a range of cells to PowerPoint but the cell values change based on a scrollbar I inserted. This is what it looks like:

I want to export the puzzle, which is Range("M1:U11"), but I want each puzzle from 1 to 300 to appear on its own separate slide on the Powerpoint Presentation. So When A6 = 1, puzzle no 1 is exported, when A = 2, puzzle no 2 is exported, and so on and so forth.



I tried adding a For and if loop (I don't fully know how thoses work tbh) but it copied and pasted cell "A6" a 155 times! Long story short, I'm stuck and I need your help. Here's the code:

Private Sub CommandButton1_Click()

'Declare our Variables
Dim r As Range
Dim powerpointapp As Object
Dim mypresentation As Object
Dim myslide As Object
Dim myshape As Object


'assigning range into variable
Set r = ThisWorkbook.Worksheets("Sheet1").Range("M1:U11")

'If we have already opened powerpoint
Set powerpointapp = GetObject(class:="PowerPoint.Application")
                  
'If powerpoint is not opened
If powerpointapp Is Nothing Then Set powerpointapp = CreateObject(class:="PowerPoint.Application")

'To create a new presentation
Set mypresentation = powerpointapp.Presentations.Add

 
 'Loop through all the values in "A6"
         'If Range("A6") = loop 1 To 100 Then Range("M1:U11").Select
         'Copy the Selection
         'Paste each iteration on a new slide on Powerpoint

Set myslide = mypresentation.slides.Add(1, 11)

r.Copy

'to paste range
myslide.Shapes.PasteSpecial DataType:=2
Set myshape = myslide.Shapes(myslide.Shapes.Count)
myshape.Left = 250
myshape.Top = 150

powerpointapp.Visible = True
powerpointapp.Activate

'to clear the cutcopymode from clipboard
Application.CutCopyMode = False


'Keep going if thee is an error
On Error Resume Next

End Sub

Thanks in advance!

 

[sijpie]

Private Sub CommandButton1_Click()

    'Declare our Variables
    Dim rR As Range, rA6 As Range
    Dim powerpointapp As Object
    Dim mypresentation As Object
    Dim myslide As Object
    Dim myshape As Object
    Dim i As Integer
    
    
    'assigning range into variable
    Set rR = ThisWorkbook.Worksheets("Sheet1").Range("M1:U11")
    Set rA6 = ThisWorkbook.Worksheets("Sheet1").Range("A6")     '<<< Is A6 also on this sheet? Else correct sheet name
    
    'If we have already opened powerpoint
    Set powerpointapp = GetObject(class:="PowerPoint.Application")
                      
    'If powerpoint is not opened
    If powerpointapp Is Nothing Then Set powerpointapp = CreateObject(class:="PowerPoint.Application")
    
    'To create a new presentation
    Set mypresentation = powerpointapp.Presentations.Add
    
     
    'Loop through all the values in "A6"
             'If Range("A6") = loop 1 To 100 Then Range("M1:U11").Select
             'Copy the Selection
             'Paste each iteration on a new slide on Powerpoint
             
    For i = 1 To 300    'Loop A6 through all values from 1 to 300
        rA6 = i
    
        Set myslide = mypresentation.slides.Add(1, 11)
        'Copy the puzzle
        rR.Copy
        
        'to paste range
        myslide.Shapes.PasteSpecial DataType:=2
        Set myshape = myslide.Shapes(myslide.Shapes.Count)
        myshape.Left = 250
        myshape.Top = 150
        
    Next i
        
    powerpointapp.Visible = True
    powerpointapp.Activate
    
    'to clear the cutcopymode from clipboard
    Application.CutCopyMode = False
    
End Sub

 

[eresylva]

Private Sub CommandButton1_Click()

    'Declare our Variables
    Dim rR As Range, rA6 As Range
    Dim powerpointapp As Object
    Dim mypresentation As Object
    Dim myslide As Object
    Dim myshape As Object
    Dim i As Integer
   
   
    'assigning range into variable
    Set rR = ThisWorkbook.Worksheets("Sheet1").Range("M1:U11")
    Set rA6 = ThisWorkbook.Worksheets("Sheet1").Range("A6")     '<<< Is A6 also on this sheet? Else correct sheet name
   
    'If we have already opened powerpoint
    Set powerpointapp = GetObject(class:="PowerPoint.Application")
                     
    'If powerpoint is not opened
    If powerpointapp Is Nothing Then Set powerpointapp = CreateObject(class:="PowerPoint.Application")
   
    'To create a new presentation
    Set mypresentation = powerpointapp.Presentations.Add
   
    
    'Loop through all the values in "A6"
             'If Range("A6") = loop 1 To 100 Then Range("M1:U11").Select
             'Copy the Selection
             'Paste each iteration on a new slide on Powerpoint
            
    For i = 1 To 300    'Loop A6 through all values from 1 to 300
        rA6 = i
   
        Set myslide = mypresentation.slides.Add(1, 11)
        'Copy the puzzle
        rR.Copy
       
        'to paste range
        myslide.Shapes.PasteSpecial DataType:=2
        Set myshape = myslide.Shapes(myslide.Shapes.Count)
        myshape.Left = 250
        myshape.Top = 150
       
    Next i
       
    powerpointapp.Visible = True
    powerpointapp.Activate
   
    'to clear the cutcopymode from clipboard
    Application.CutCopyMode = False
   
End Sub

Thanks, I had also tried something that worked.

Dim i As Long
...
For i = 1 To 300
Range("A6").Select
ActiveCell.FormulaR1C1 = i
r.Copy
...
Thanks a bunch

 

[sijpie]

For your information, de also my code, you don't need to select a cell in order to change it's value or read it's value. Just tell vha what to do. Selecting a cell is a (relative) very slow process, so the less you select the better. Sometimes it needs to be done, but mostly not.

For example if you want to copy a cell or range to another range, don't select and copy, just tell VBA to give the other range the same value (or formula) as the original range:

range("B6:B12").value = range("A1:A7").value

There are some more coding tips in the guideline linked below.

 

[eresylva]

For your information, de also my code, you don't need to select a cell in order to change it's value or read it's value. Just tell vha what to do. Selecting a cell is a (relative) very slow process, so the less you select the better. Sometimes it needs to be done, but mostly not.

For example if you want to copy a cell or range to another range, don't select and copy, just tell VBA to give the other range the same value (or formula) as the original range:

range("B6:B12").value = range("A1:A7").value

There are some more coding tips in the guideline linked below.

No wonder it took a while for all 300 export and I couldn't do anything on my computer until it finished copying (because I have a rather slow laptop)...

I really appreciate the tips. I'm going through them as I write this. It really breaks down some of the codes I have seen but didn't even bother to look up.

If it's no bother can you help me with the VBA code to arrange them neatly across all slides? I want to place them four or six per slide. The First Two side by side, the next two just down below, then the next two, then it shifts to the next slide and continues all the way to 300.

I don't know if it would be better to export it as a PNG image file as that would reduce the size of the overall document. Either way, sorry to Oliver Twist this. I swear this is the final demand I'll make in this particular thread

 

[sijpie]

Hey, I'm not helping on this forum because I hate the job!

So, no bother. Only thing is it will have to wait until coming week.

 

[sijpie]

Can you post an image of a slide layout? Is there a title of sorts? What size slide do you use? Space between puzzles?

 

[eresylva]

Can you post an image of a slide layout? Is there a title of sorts? What size slide do you use? Space between puzzles?

I had something like this in mind:

 

[sijpie]

great. Another request: can you post screenshot of the range M1:U11, and please indicate column widths an row height, so I can format the copies on the sheet.

Do you want them to be pasted as an image or as a table? If you publish them as powerpoint or as pdf, and you want users to be able to copy words or numbers, then pasting as image will be no use.

 

[eresylva]

great. Another request: can you post screenshot of the range M1:U11, and please indicate column widths an row height, so I can format the copies on the sheet.

Do you want them to be pasted as an image or as a table? If you publish them as powerpoint or as pdf, and you want users to be able to copy words or numbers, then pasting as image will be no use.

Here is the screenshot of the range>>>>>

Each column width is 4.71, and the column height for each cell is 27.75. I'm guessing the value is in points idk.

I want them pasted as images. The end goal is to have them in PDF format (that is easy conversion-wise). I'm sorry for stressing you out with this -- I haven't had the time to fully delve into Excel VBA programming.