How can I get Pastespecial to paste a textbox and not an image?

[cabotha]

I am using the below code to create a PPT presentation with each slide representing a company asset and some information on it.

I am trying to get the Range("V6:W6") to paste as a textbox in the powerpoint but it is only pasting as a textbox.

Range("V6:W6").Copy
mySlide.Shapes.PasteSpecial DataType:=2
 Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
      myShape.Left = 0
      myShape.Top = 0

Here is all the code:

 Sub repplan()
 

 
 'POWERPOINT SETUP -----------------------------------------------------------------------------------------------------------------
 
Dim PowerPointApp As Object
Dim myPresentation As Object

'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
  
  'Create a New Presentation
  Set myPresentation = PowerPointApp.Presentations.Add
  
'POWERPOINT SETUP COMPLETE -----------------------------------------------------------------------------------------------------------------
 
 
 'SELECTING THE DATA TO USE (SITE NUMBER COLUMN AND ALL CELLS USED IN THE WORKSHEET--------------------------------------------------------------
 
  Dim rng As Range
 'Set Range from Excel
Set rng = Sheet1.Range("A1:S208")

Range("S5").Select

'SELECTING CELLS COMPLETE --------------------------------------------------------------------------------------------------------------------------
      
'LOOP-----------------------------------------------------------------------------------------------------------------------------
     
      ' Set Do loop to stop when an empty cell is reached.
      Do Until IsEmpty(ActiveCell)
      
 
  

ActiveCell.Copy Sheet1.Range("P4")

Dim mySlide As Object
Dim myShape As Object




'Optimize Code
  Application.ScreenUpdating = False

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

'Copy Excel Range
  Range("A1:M36").Copy

'Paste to PowerPoint and position
  mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
  Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    'Set position and size:
      myShape.Left = 0
      myShape.Top = 0
    myShape.Height = 540
    myShape.Width = 720
'Make PowerPoint Visible and Active
  PowerPointApp.Visible = True
  PowerPointApp.Activate

'Clear The Clipboard
  Application.CutCopyMode = False
  
'Copy and paste the site number text box into the powerpoint
Range("V6:W6").Copy
mySlide.Shapes.PasteSpecial DataType:=2
 Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
      myShape.Left = 0
      myShape.Top = 0

    'Clear The Clipboard
  Application.CutCopyMode = False
  
  
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
         
      Loop
'LOOP COMPLETE---------------------------------------------------------------------------------------------------------------------------------
    
'DIALOG BOX TO CONFIRM TRANSFER HAS BEEN COMPLETED WITHOUT ERRORS
MsgBox ("Completed transfer to Powerpoint")

   End Sub

 

[ZVI]

Try the below code instead of mySlide.Shapes.PasteSpecial DataType:=2

    'Paste to PowerPoint and position
    Const ppPasteText = 7
    PowerPointApp.ActiveWindow.View.PasteSpecial ppPasteText ' Or use PowerPointApp.ActiveWindow.View.Paste