Consulting

Results 1 to 3 of 3

Thread: Paste Excel Range into Powerpoint

  1. #1

    Paste Excel Range into Powerpoint

    Hello,

    I found an interesting code at: https://www.thespreadsheetguru.com/b...point-with-vba

    Now I want to adapt the code, that it doesnīt always open a new ppt, but pastes it in the presentation which is open (into a new tab). I tries to modify the code but it didnīt work. Can somebody help`?

    Office 2016, I already activated the PPT Library in VBA.

    Here ist the code

    PHP Code:
    Sub ExcelRangeToPowerPoint()
    'PURPOSE: Copy/Paste An Excel Range Into a New PowerPoint Presentation
    '
    SOURCEwww.TheSpreadsheetGuru.com

    Dim rng 
    As Range
    Dim PowerPointApp 
    As Object
    Dim myPresentation 
    As Object
    Dim mySlide 
    As Object
    Dim myShape 
    As Object

    '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

    'Add a slide to the Presentation
      Set mySlide = myPresentation.Slides.Add(1, 11) '
    11 ppLayoutTitleOnly

    '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
      
    End Sub 

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,235
    A linked range:

    Sheet1.Range("C6:F17") in the file that contains the macro

    Sub M_snb()
      c00 = ActiveWorkbook.Path & "\"
      c01 = Replace(Mid(Sheet1.Range("C6:F17").Address(, , 2, 2), 2), "]", "!")
       
      With CreateObject("powerpoint.application")
        .Visible = True
        .presentations.Add().slides.Add(1, 12).Shapes.AddOLEObject 20, 20, , , , c00 & c01, , , , , True
      End With
    End Sub
    NB. The simpler the code the simpler to adapt.

    To add in a presentation that is already open:

    Sub M_snb_001()
       c00 = ActiveWorkbook.Path & "\"
       c01 = Replace(Mid(Sheet1.Range("C6:F17").Address(, , 2, 2), 2), "]", "!")
       
        With GetObject(, "powerpoint.application")
           .Visible = True
           .presentations(1).slides.Add(1, 12).Shapes.AddOLEObject 20, 20, , , , c00 & c01, , , , , True
        End With
    End Sub
    Last edited by snb; 07-19-2021 at 04:00 AM.

  3. #3
    When I run your code it says object not found.

    I tried to modify the code, becuase the one posted upside is working.

    PS: Iīm new to VBA

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •