Try this
same code instead of exporting as pdf pasting into a power point as Enhanced Metafile
Option Explicit
Sub copy2powerpnt()
Dim strDirContainingFiles As String, strFile As String, strFilePath As String, xFolder As String
Dim wbkSrc As Workbook
Dim wksSrc As Worksheet, xWS As Worksheet
Dim lngIdx As Long
Dim t0 As Double
Dim c00 As Variant, c01 As Variant
Dim colFileNames As Collection
Set colFileNames = New Collection
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then
MsgBox "You did not select a folder."
Exit Sub
End If
strDirContainingFiles = .SelectedItems(1) & "\"
End With
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
strFile = Dir(strDirContainingFiles & "\*.xl*")
Do While Len(strFile) > 0
colFileNames.Add Item:=strFile
strFile = Dir
Loop
If colFileNames.Count = 0 Then
MsgBox "There are no excel files in this folder."
Exit Sub
Else
MsgBox "There are " & colFileNames.Count & " excel files in this folder."
End If
t0 = CDbl(Now())
On Error Resume Next
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
Err.Clear
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
Set myPresentation = PowerPointApp.Presentations.Add
For lngIdx = 1 To colFileNames.Count
strFilePath = strDirContainingFiles & "\" & colFileNames(lngIdx)
Set wbkSrc = Workbooks.Open(strFilePath)
For Each xWS In wbkSrc.Sheets
If xWS.Name = "o0omax" Then '< change based on your Sheet name
Set wksSrc = wbkSrc.Worksheets(xWS.Name)
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
wksSrc.UsedRange.Copy
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Left = 66
myShape.Top = 152
' xFolder = strDirContainingFiles + "\" + wbkSrc.Name + ".pdf"
' wksSrc.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
Exit For
End If
Next xWS
wbkSrc.Close savechanges:=False
Next lngIdx
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
MsgBox Format(Now - t0, "hh:mm:ss"), vbInformation, "Completed!"
PowerPointApp.Visible = True
PowerPointApp.Activate
End Sub