Копирование и диапазон ячеек как изображения с определенной шириной. Заблокированное соотношение сторон

Question

Показанный макрос успешно определяет имя рабочего листа и именованный диапазон ячеек в этом рабочем листе, а затем копирует диапазон на другой рабочий лист (обзор) в той же книге, что и изображение, устанавливая определенную ширину для изображения и блокируя его. соотношение сторон.

Sub Copy_Dock_OptionsNew()  'Copy relevant Drive on Dock Options drawing and prices
                        'Use Dock Size to select correct input sheet

Dim dws, sws As Worksheet
Dim DrawingCode, swsName As String
Dim i As Integer

Application.ScreenUpdating = False

Set dws = Worksheets("Overview")

With dws

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Determine Drawing Range Code
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    DrawingCode = "DOD" & Range("Dock_size") & "xOptions"

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Determine Source Worksheet name (= DOD & Dock_Size value
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    swsName = "DOD" & dws.Range("Dock_Size")

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Copy relevant dock summary drawing to Overview sheet
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Worksheets(swsName).Range(DrawingCode).CopyPicture xlScreen, xlPicture
    dws.Range("U13").Select
    dws.Paste
    Selection.ShapeRange.LockAspectRatio = True
    Selection.ShapeRange.Width = 420

End With
End Sub

Это использует Select, чтобы определить область вставки, которую я предпочитаю не использовать, поэтому попробовал следующее. Это работает, но как мне исправить ширину и зафиксировать соотношение сторон?

Sub Copy_Dock_OptionsNew()  'Copy relevant Drive on Dock Options drawing and prices
                        'Use Dock Size to select correct input sheet

Dim dws, sws As Worksheet
Dim DrawingCode, swsName As String
Dim i As Integer

Application.ScreenUpdating = False

Set dws = Worksheets("Overview")

With dws

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Determine Drawing Range Code
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    DrawingCode = "DOD" & Range("Dock_size") & "xOptions"

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Determine Source Worksheet name (= DOD & Dock_Size value
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    swsName = "DOD" & dws.Range("Dock_Size")

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Copy relevant dock summary drawing to Overview sheet
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Worksheets(swsName).Range(DrawingCode).CopyPicture _
       Appearance:=xlScreen, _
       Format:=xlPicture
    dws.Paste _
        Destination:=dws.Range("U13")
End With
End Sub

Answer 1

Попробуйте следующий код ...

With dws
    .Paste Destination:=.Range("U13")
    With .Shapes(.Shapes.Count)
        .LockAspectRatio = msoTrue
        .Width = 420
    End With
End With

Хотя, похоже, соотношение сторон уже заблокировано после вставки изображения.