How can I independently resize Pictures pasted to a Worksheet

Question

I am looking for a way to resize pictures of tables revised and pasted daily to a report. Here is a description of my objective, problem, and suggested resolution (that I can’t figure out how to code).

MY OBJECTIVE: my code needs to - 1) copy a Picture of a table called TABLE A from the TABLE Worksheet and then - 2) paste the TABLE A Picture to Cell B2 on the OUTPUT Sheet, then - 3) resize the pasted TABLE A Picture. LATER, when - 1) the OUTPUT Sheet is next activated, to - 2) delete all Pictures on the OUTPUT Sheet including the existing TABLE A Picture pasted in Cell B2 (this code has been omitted for brevity), and - 3) copy a new and updated TABLE A from the TABLE Sheet, then - 4) paste the newly copied Picture of TABLE A to B2 on the OUTPUT Sheet, then - 5) resize the newly pasted TABLE A to the exact dimensions as applied to the previously pasted but now deleted TABLE A. THE PROBLEM: VBA assigns a Picture Name as a ShapeRange (say “Picture 1” or “ShapeRange (1)) to the original TABLE A Picture pasted to the OUTPUT Sheet, then after “Picture 1” has been deleted, VBA assigns a different Name or ShapeRange (say “Picture 2” or “ShapeRange (2)) to the new copy of each and every updated TABLE A copied from the TABLE Sheet and pasted to the same location on the OUTPUT Sheet. Unfortunately, my VBA Picture (or ShapeRange) resizing code has no way to recognize that the Picture Name has changed, so it will try, as in this example, to resize “Picture 1” (which no longer exists) instead of the newly pasted “Picture 2”. RESOLUTION: I either need code that makes the Name of each new Picture copy/pasted to a specific location on the OUTPUT Sheet always be the same Name as the Picture previously deleted from the same location (e.g. every new TABLE A pasted to the OUTPUT Sheet is always Named “Picture 1”), OR the resizing code is changed so it recognizes and is applicable to whatever new Name VBA assigns to each newly copied TABLE A Picture that is pasted to the OUTPUT Sheet replacing the previously deleted Picture’s Name.

A solution to this problem will be much appreciated?

'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

Ok, now it makes a lot more sense with your edit.

You mentioned you want to trigger it on Worksheet_Activate so the below is written for this event.

It is more or less what you had written, but uses Shapes.Count as the index number for the Shapes() collection. This means the most recent shape added will be the one affected by our changes.

I added a statement to rename it (the name of the source sheet) but that can be excluded if there is no need for it.

I've also contained the brunt of the code within a With statement to shorten our code as a lot of the calls require the sheet qualification.

I tested this with the following differences:

• Worksheets("DATA") was tested as Worksheets("Sheet1")
• Worksheets("OUTPUT") was tested as Worksheets("Sheet2")
• Worksheets("CHART") was tested as Worksheets("Sheet3")

I manually deleted both pictures from Sheet2 each time and then navigated away from and then back to Sheet2 to trigger the code again - Each time I got the same results as expected (screenshots below code).

My Code:

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

Screenshot of output:

The data in the "DATA" and "CHART" ranges that are copied are filled with "Sheet1" and "Sheet3" respectively as filler data.

After numerous tests and manually deleting the pasted pictures each time before navigating away from and back to "Sheet2" ("OUTPUT") this is the constant result: