From a few Excel files to PowerPoint - vba

Question

I'm totally new in VBA programming. However I have to (and want) create macro in Excel file to automatically creating PowerPoint presentation.
I hope that someone will be able to help me or have a similar problem.
Namely - I have 6 columns in the Excel file:
1 - slide number
2 - file access path
3 - file name
4 - sheet name
5 - slide range
6 - slide title
I would like the macro to automatically enter a given file -> sheet -> take the slide's range, copy and paste it as a picture for the presentation and give it the appropriate title and go through the loop to the next line and do the same.
Is anyone able to help me? Below is the code that I managed to write, however, I do not know how to refer to the sheet and the range of the slide from the given cell.
Option Explicit
Sub ExcelRangeToPowerPoint()
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim adr1 As String
Dim shta As Worksheet
Dim wrk As String
Application.DisplayAlerts = False
wrk = ThisWorkbook.Name ' nname
adr1 = Worksheets("Sheet1").Range("B2")
'Copy Range from Excel
' Set rng = ThisWorkbook.ActiveSheet.Range("A1:C12")
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Optimize Code
Application.ScreenUpdating = False
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
ThisWorkbook.Activate
Range("A2").Select
'DO While
Do While ActiveCell.Value <> ""
Workbooks.Open Filename:=(ActiveCell.Offset(0, 1) & "\" & ActiveCell.Offset(0, 2)), UpdateLinks:=0, ReadOnly:=True ' to be sure read-only open
' Worksheet Open from D2
'Copy Range from E2
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile + title from F2
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
ActiveWorkbook.Close SaveChanges:=False ' close file and don't save
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
MsgBox ("Ready")
Application.CutCopyMode = False
Application.DisplayAlerts = True
End Sub

Answer 1

You can always refer to some sheet or Workbook creating first variables type Workbook or Worksheets.
If you want to refer a variable to a worksheet/workbook, is pretty easy. Is just a set. Something like:
Dim wb as Workbook
Set wb = ThisWorkbook
Now wb will be referenced to ThisWorkbook Object. With Worksheets is the same. You refer exactly the same way:
Dim ws as Worksheet
Set ws = ActiveSheet
Now ws is referenced to activesheet and you can handle it from ws.
I hope this answered some of your doubts. About your code, the loop part should be something like this:
Dim MyWb As Workbook 'variable for workbook
Dim MyWs As Worksheet 'variable for worksheet
ThisWorkbook.Activate
Range("A2").Select
'DO While
Do While ActiveCell.Value <> ""
ThisWorkook.Activate
Set MyWb = Workbooks.Open(Filename:=(ActiveCell.Offset(0, 1) & "\" & ActiveCell.Offset(0, 2)), UpdateLinks:=0, ReadOnly:=True) ' to be sure read-only open
' Worksheet Open from D2
Set MyWs = MyWb.Worksheets(ActiveCell.Offset(0, 3).Value) 'now MyWs is referenced to the worksheet in column D
'Copy Range from E2
MyWs.Activate
MyWs.Range(ActiveCell.Offset(0, 4).Value).Copy 'we copy the range shown in column E
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile + title from F2
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'after pasting, we go back to active workbook
Application.CutCopyMode = False
MyWb.Activate
MyWb.Close SaveChanges:=False ' close file and don't save
Set MyWs = Nothing
Set MyWb = Nothing
ActiveCell.Offset(1, 0).Select 'we go 1 row down
Loop
I hope you can test it and tell me if it helped you to make thing clear :)

Answer 2

Really Thanks for answer
I had to use "ThisWorkbook.Activate" in a few places.
And now this macro work almost perfect.. it means that the order of creating slides is reversed : 1 is the last and the last is 1..
What is more I'd like to also create Title of each slide from Excel file column F.
Below my VBA code:
Sub VBA_PowerPoint()
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim MyWb As Workbook 'variable for workbook
Dim MyWs As Worksheet 'variable for worksheet
Dim MyRg As Excel.Range ' variable for Range
Application.DisplayAlerts = False
ThisWorkbook.Activate
Range("A2").Select
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Optimize Code
Application.ScreenUpdating = False
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
'Do While
ThisWorkbook.Activate
Do While ActiveCell.Value <> ""
ThisWorkbook.Activate
Set MyWb = Workbooks.Open(Filename:=(ActiveCell.Offset(0, 1) & "\" & ActiveCell.Offset(0, 2)), UpdateLinks:=0, ReadOnly:=True) ' to be sure read-only open
' Worksheet Open from D2
ThisWorkbook.Activate
Set MyWs = MyWb.Worksheets(ActiveCell.Offset(0, 3).Value) 'now MyWs is referenced to the worksheet in column D
'Copy Range from E2
' Set MyRg = MyWs.Range(ActiveCell.Offset(0, 4).Value) 'now MyWs is referenced to the worksheet in column E
' MyWs.Range(MyRg).Copy 'we copy the range shown in column E
ThisWorkbook.Activate
MyWs.Range(ActiveCell.Offset(0, 4).Value).Copy
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile + title from F2
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'after pasting, we go back to active workbook
Application.CutCopyMode = False
MyWb.Activate
MyWb.Close SaveChanges:=False ' close file and don't save
Set MyWs = Nothing
Set MyWb = Nothing
ActiveCell.Offset(1, 0).Select 'we go 1 row down
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub