Изменение размера изображения из Excel в PPt

Question

У меня есть код ниже, чтобы скопировать изображение из диапазона ячеек Excel в PPT, но изображение, вставленное в PPT, имеет разные размеры. Может кто-нибудь сказать мне, как я могу исправить размер изображения при вставке в PPT. Я добавляю код ниже для вашей справки.

Private Sub CommandButton1_Click()

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

'Unhiding the sheets
  Worksheets("Sheet4").Visible = xlSheetVisible

'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

'Mupltiple Slides
    'List of PPT Slides to Paste to
    MySlideArray = Array(1, 2, 3)

    'List of Excel Ranges to Copy from
    MyRangeArray = Array(Sheet2.Range("A1:AB71"), Sheet1.Range("A1:AL70"), Sheet5.Range("A1:AE56"))

    'Loop through Array data
    For x = LBound(MySlideArray) To UBound(MySlideArray)

'Add a slide to the Presentation
  Set mySlide = myPresentation.Slides.Add(1, 12) '12 = ppLayoutBlank 'https://docs.microsoft.com/en-us/office/vba/api/powerpoint.ppslidelayout

'Copy Excel Range
  'rng.Copy
  MyRangeArray(x).Copy
  Application.Wait (Now + TimeValue("0:00:03"))
'Paste to PowerPoint and position
  mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
  Set myShape = mySlide.Shapes(mySlide.Shapes.count)

    'Set position:
      myShape.Left = 0
      myShape.Top = 0


  Next x
  'Message Box
   MsgBox ("Please is ready !!")


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

'Clear The Clipboard
  Application.CutCopyMode = False

'Hiding the sheets back
  Worksheets("Sheet4").Visible = xlSheetHidden
End Sub