Copy a Text Box from Excel and Paste into PPTX presentation Slide

[dazfoz]

Hi All,

Ive been working on the attached for a few days, Ive managed to get most data into my Slide how I want it to look in the PowerPoint Slide, but the only problem that im having is how to copy a textbox from excel, and past into my slide.

Ive tried numerous permutations of Dimensions and Pasting but cant seem to figure it.

If its not possible then does anyone know how to create (And format) a textbox in PPTX from VBA in Excel 2010.

You can see my current attempt as 'rng5'

Hopefully someone can spot a simple mistake Ive made or missed.

Thanks Daz.

Sub ExportToPowerPointLandscape()

Dim rng As Range
Dim rng2 As Range
Dim rng3 As Object
Dim rng4 As Range
Dim rng5 As Object
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim myTextbox As Object


'Turn Off Gridlines so pasted image looks neater
    ActiveWindow.DisplayGridlines = False
    
'Copy Range from Excel
  Set rng = ThisWorkbook.ActiveSheet.Range("B6:J9")
  Set rng2 = ThisWorkbook.ActiveSheet.Range("B12:O17")
  Set rng3 = ThisWorkbook.ActiveSheet.ChartObjects("Chart 1")
  Set rng4 = ThisWorkbook.ActiveSheet.Range("BradgateTitle")
  Set rng5 = ThisWorkbook.ActiveSheet.Shapes.Range(Array("TextBox 2"))
  
'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

'Turn Screen Updating off
  application.ScreenUpdating = False
  
'Create a New Presentation
  Set myPresentation = PowerPointApp.Presentations.Add

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

'Paste IIR
  rng.Copy

        'Paste to PowerPoint and position
          mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
          
          Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
         
            ' Unlock Aspect Ratio so that resizing of original sheet deosnt effect the placement in the PPT.
              myShape.LockAspectRatio = msoFalse
         
            'Set position:
              myShape.Left = 10
              myShape.Top = 55
              myShape.Width = 700
              myShape.Height = 70
      
'Paste Incicent rate table
  rng2.Copy

        'Paste to PowerPoint and position
          mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
          
          Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
             
         'Set position:
              myShape.LockAspectRatio = msoFalse
              myShape.Left = 10
              myShape.Top = 132
              myShape.Width = 700
              myShape.Height = 80
              
'Paste Incicent rate Graph
  rng3.Copy

        'Paste to PowerPoint and position
          mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
          
          Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
          
              myShape.LockAspectRatio = msoFalse
              myShape.Left = 10
              myShape.Top = 215
              myShape.Width = 700
              myShape.Height = 220
              
'Paste Bakery Title
    rng4.Copy

          'Paste to PowerPoint and position
           mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
        
          Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
            
                myShape.LockAspectRatio = msoFalse
                myShape.Left = 10
                myShape.Top = 8
                myShape.Width = 140
                myShape.Height = 53
      
  'Paste Bakery Title
    rng5.Copy

          'Paste to PowerPoint and position
           mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
        
          Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
            
                'myShape.LockAspectRatio = msoFalse
                myShape.Left = 10
                myShape.Top = 250
                myShape.Width = 140
                myShape.Height = 53
      

'Make PowerPoint Visible and Active
  PowerPointApp.Visible = True
  PowerPointApp.Activate

'Clear The Clipboard
  application.CutCopyMode = False
  
'Turn Screen Updating off
  application.ScreenUpdating = True
  
End Sub