Copy a range of Excel cells to an "image" object by VBA

Question

I need to copy a track from an Excel spreadsheet that contains a graphic scheme made with borders around some cells, with some background colors and text, and view this scheme in a VBA "image" object.

With the code below the range of cells that composes the figure is copied from the current spreadsheet to another name "Image", and is copied as image (as accurate), but I could not get a way to put it in the object "image", or even to paste it directly in the object "image" (so the spreadsheet "Image" would be unnecessary).

Range("D19:H25").Select

Application.CutCopyMode = False

Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

Sheets("Imagem").Activate

Range("A1").Select

ActiveSheet.Paste

In an attempt to find a solution, by manually selecting the cells containing the image, and in "Home", "Copy as image" (appearance: as shown on screen, and format: Bitmap); by clicking on properties of the "image" object in the "Picture" field where it is described "none" and give "paste" in this field, appears the word "Bitmap" and in the object "image" appears the image as desired.

I tried and researched automate this same procedure in VBA, including doing it by macro and analyzing the code, but evidently the code of the part that the deviation is made to the VBA to "paste" the track selected in the property of the object (Picture) is not recorded in the macro.

As the graphic scheme is changed dynamically by the user (via VBA), whenever the user enters a given form this object "image" needs to present the current image, as many times as the user wants to refine this image.

How to fix it the way I need to?

Answer 1

Simply delete the previous image (saving the position it is in) and update the new image with the same name and position. Here’s the code:

Set oImage = ActiveSheet.Shapes.Item("Imagem 1")
x = oImage.Left
y = oImage.Top
oImage.Delete

' Seu código
' -------------
Range("e7:E9").Select

Application.CutCopyMode = False

Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

ActiveSheet.Paste Destination:=ActiveSheet.Range("J19:N25")
' -------------

ActiveSheet.Shapes.Item(ActiveSheet.Shapes.Count).Name = "Imagem 1"
Set oImage = ActiveSheet.Shapes.Item("Imagem 1")
oImage.Left = x
oImage.Top = y

IMPORTANT: Note that in this answer I just demonstrate how to update an existing image with a new image generated from the data of a selected range. In your other question, my answer demonstrates how to save this image (not range!) to a file. No the final questions are not duplicated, but it was totally needless to have two to solve your problem. If you had be more organized when asking, would have avoided all small confusions and got your answer faster. Gets the pro tip future. :)