Как я могу самостоятельно изменить размеры картинок, вставленных в лист

Question

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

МОЯ ЗАДАЧА: моему коду необходимо - 1) скопировать изображение таблицы с именем TABLE A из таблицы TABLE, а затем - 2) вставить изображение TABLE A в ячейку B2 на Выходной лист, затем - 3) измените размер вставленной ТАБЛИЦЫ A Изображение. ПОЗЖЕ, когда - 1) лист ВЫХОДА активируется следующим образом, - 2) удалить все Изображения на Листе ВЫХОДА, включая существующую ТАБЛИЦУ A Изображение, вставленное в Ячейку B2 (этот код был опущен для краткости), и - 3) скопировать новая и обновленная ТАБЛИЦА А из таблицы ТАБЛИЦА, затем - 4) вставьте только что скопированное изображение ТАБЛИЦЫ А в В2 на листе ВЫХОД, затем - 5) измените размер вновь вставленной ТАБЛИЦЫ А до точных размеров применительно к ранее вставленной, но теперь удалено ТАБЛИЦА А. ПРОБЛЕМА: VBA назначает имя изображения в качестве ShapeRange (скажем, «Изображение 1» или «ShapeRange (1)) для исходного TABLE A Изображение, вставленное в выходной лист, затем после« Изображение 1 »было удалено, VBA назначает другое Имя или ShapeRange (скажем,« Изображение 2 »или« ShapeRange (2)) новой копии каждой обновленной таблицы TABLE A, скопированной из таблицы TABLE и вставленной в то же место на выходной лист. К сожалению, мой код изменения размера изображения VBA (или ShapeRange) не может распознать, что имя изображения изменилось, поэтому он попытается, как в этом примере, изменить размер «изображения 1» (которого больше не существует) вместо недавно вставленного «Изображение 2». РАЗРЕШЕНИЕ: Мне либо нужен код, который делает имя каждого нового изображения, копируемого / вставляемого в указанное c расположение на Листе ВЫХОДА, всегда одинаковым Именем поскольку изображение, ранее удаленное из того же места (например, каждый новый TABLE A, вставленный в лист OUTPUT, всегда называется «рисунок 1»), ИЛИ код изменения размера изменяется, так что он распознает и применим к любому новому имени, которое VBA назначает каждому новому скопированный TABLE A Изображение, которое вставляется в выходной лист, заменяя ранее удаленное имя изображения.

Решение этой проблемы будет высоко ценится?

'Copies TABLE Picture and Pastes on OUTPUT Worksheet
Worksheets("TABLE").Range("a1:O29").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Worksheets("OUTPUT").Paste _
Destination:=Worksheets("OUTPUT").Range("B2")

'Resizes TABLE Picture on OUTPUT Worksheet
        Dim Shp As Shape
        Dim lWidth As Long, lHeight As Long

            Set Shp = ActiveWindow.Selection.ShapeRange(1)

            lHeight = Shp.Height
            lWidth = Shp.Width

            hp.Height = 3 * 72 * lHeight / lWidth
            Shp.Width = 4.75 * 72

'Copies CHART Picture and Pastes on OUTPUT Worksheet
Worksheets("CHART").Range("A1:j17").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Worksheets("OUTPUT").Paste _
Destination:=Worksheets("OUTPUT").Range("B18")


End Sub```

Answer 1

Хорошо, теперь это стало намного понятнее с вашей правкой.

Вы упомянули, что хотите запустить его на Worksheet_Activate, поэтому для этого события написано ниже.

Это более или менее то, что вы написали, но использует Shapes.Count в качестве номера индекса для коллекции Shapes(). Это означает, что последняя добавленная форма будет зависеть от наших изменений.

Я добавил оператор для его переименования (имя исходного листа), но его можно исключить, если в этом нет необходимости.

Я также содержал основную часть кода в выражении With, чтобы сократить наш код, так как для многих вызовов требуется квалификация листа.

Я проверил это со следующими отличиями:

• Worksheets("DATA") был протестирован как Worksheets("Sheet1")
• Worksheets("OUTPUT") был протестирован как Worksheets("Sheet2")
• Worksheets("CHART") было протестировано как Worksheets("Sheet3")

Я вручную удалял оба изображения из Sheet2 каждый раз, а затем перемещался от и затем обратно к Sheet2, чтобы снова вызвать код - Каждый раз я получал те же результаты, что и ожидалось (скриншоты ниже кода).

Мой код:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "OUTPUT" Then

    'Copies TABLE Picture and Pastes on OUTPUT Worksheet
    Worksheets("DATA").Range("a1:O29").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Worksheets("OUTPUT").Paste Worksheets("OUTPUT").Range("B2")

    With Worksheets("OUTPUT").Shapes(Worksheets("OUTPUT").Shapes.Count)
        .Name = "DATA"

    'Resizes TABLE Picture on OUTPUT Worksheet
        Dim lWidth As Long, lHeight As Long

        lHeight = .Height
        lWidth = .Width

        .Height = 3 * 72 * lHeight / lWidth
        .Width = 4.75 * 72
    End With

    'Copies CHART Picture and Pastes on OUTPUT Worksheet
    Worksheets("CHART").Range("A1:j17").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Worksheets("OUTPUT").Paste Worksheets("OUTPUT").Range("B18")
End If
End Sub

Снимок экрана с выводом:

Данные в «ДАННЫХ» и скопированные диапазоны «CHART» заполняются соответственно «Sheet1» и «Sheet3» в качестве данных-заполнителей.

После многочисленных тестов и ручного удаления вставленных изображений каждый раз перед переходом от «Лист2» ​​(«ВЫХОД») и обратно к нему это постоянный результат: