RandomGerman
05-19-2017, 09:52 AM
Dear all,
I have a few experiences in coding VBA for PowerPoint, but this is the first time I have a need in VBA for Excel. (And the first time I'm posting in the Excel section of this helpful forum. Hello to all! :-) )
As VBA for PowerPoint and for Excel might be brothers, but not twins, some of my pieces of code work and others don't.
I am looking for a macro to copy ranges from Excel and paste them as pictures to PowerPoint. I found something Chris (the spreadsheetguru) wrote, which is very close to what I want to do.
I tried two modifications.
The first was an Input box, giving the user the chance to define the range of cells by himself. This part seems to work.
The second: I want to paste to the active slide, not add a new one, which is, what actually happens.
This is where I stand, please have a look at the comments:
Option Explicit
Sub ExcelRangeToPowerPoint()
'PURPOSE: Copy/Paste An Excel Range To The Active PowerPoint Slide
'SOURCE: Most of it: www.TheSpreadsheetGuru.com (http://www.TheSpreadsheetGuru.com) - few modifications: Me. :-)
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim Message As String
Dim Title As String
Dim Default As String
Dim myValue As String
Message = "Please enter Range of cells you want to transfer" & vbCrLf & "Examples:" & vbCrLf & "A1:C10 - for a range" & vbCrLf & "or: F42 - for one cell"
Title = "Transfer to PowerPoint - Input box"
Default = "A1:C10"
myValue = InputBox(Message, Title, Default)
'Handles if User cancels
On Error GoTo UserCancels
'Copy Range from Excel
Set rng = ThisWorkbook.ActiveSheet.Range(myValue)
'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.ActivePresentation
'The next line of code is not what I want.
'I want to define mySlide as the active slide.
'I tried: Set mySlide = ActiveWindow.View.Slide <= Would work in PPT, but in Excel debugging didn't accept it
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11)
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = 66
myShape.Top = 152
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Clear The Clipboard
Application.CutCopyMode = False
Exit Sub
UserCancels:
Exit Sub
End Sub
Finally, I need help for three points:
1. A solution for the active slide problem (marked with a Long comment in the code)
2. An error message in the right moment, in case no PowerPoint presentation is open
3. As there are some parts in Chris' code I must admit I don't understand, I have no idea if they are still necessary after all modifications. Please feel free to optimize and/or clean up anything you see. If there is room for improvement, please improve. :-)
Thanks a lot in advance
RG
I have a few experiences in coding VBA for PowerPoint, but this is the first time I have a need in VBA for Excel. (And the first time I'm posting in the Excel section of this helpful forum. Hello to all! :-) )
As VBA for PowerPoint and for Excel might be brothers, but not twins, some of my pieces of code work and others don't.
I am looking for a macro to copy ranges from Excel and paste them as pictures to PowerPoint. I found something Chris (the spreadsheetguru) wrote, which is very close to what I want to do.
I tried two modifications.
The first was an Input box, giving the user the chance to define the range of cells by himself. This part seems to work.
The second: I want to paste to the active slide, not add a new one, which is, what actually happens.
This is where I stand, please have a look at the comments:
Option Explicit
Sub ExcelRangeToPowerPoint()
'PURPOSE: Copy/Paste An Excel Range To The Active PowerPoint Slide
'SOURCE: Most of it: www.TheSpreadsheetGuru.com (http://www.TheSpreadsheetGuru.com) - few modifications: Me. :-)
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim Message As String
Dim Title As String
Dim Default As String
Dim myValue As String
Message = "Please enter Range of cells you want to transfer" & vbCrLf & "Examples:" & vbCrLf & "A1:C10 - for a range" & vbCrLf & "or: F42 - for one cell"
Title = "Transfer to PowerPoint - Input box"
Default = "A1:C10"
myValue = InputBox(Message, Title, Default)
'Handles if User cancels
On Error GoTo UserCancels
'Copy Range from Excel
Set rng = ThisWorkbook.ActiveSheet.Range(myValue)
'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.ActivePresentation
'The next line of code is not what I want.
'I want to define mySlide as the active slide.
'I tried: Set mySlide = ActiveWindow.View.Slide <= Would work in PPT, but in Excel debugging didn't accept it
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11)
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = 66
myShape.Top = 152
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Clear The Clipboard
Application.CutCopyMode = False
Exit Sub
UserCancels:
Exit Sub
End Sub
Finally, I need help for three points:
1. A solution for the active slide problem (marked with a Long comment in the code)
2. An error message in the right moment, in case no PowerPoint presentation is open
3. As there are some parts in Chris' code I must admit I don't understand, I have no idea if they are still necessary after all modifications. Please feel free to optimize and/or clean up anything you see. If there is room for improvement, please improve. :-)
Thanks a lot in advance
RG