insert picture using vba

[robertmwaring2]

Hello,

I have been trying for three days now (totaling more than 24 hours of time) trying to get an image inserted into a sheet using vba. I have a workbook that uses a userform to capture the address (directory) of the picture for each item entered into the userform. All the details for each item entered are stored in a table on one sheet (ActiveWorksheet.Sheet1). Once an item is entered, the user clicks a button to add the next item. Once all items are entered, the user clicks another button to create separate sheets for each item entered based on a template sheet (ActiveWorksheet.Sheet2). Sheet2 is copied (in the same workbook) "x" number of times where x is the number of items that were entered. On each of the new sheets, I am trying to have the picture selected from the form (address/directory for picture is in Sheet1) added (not inserted) to each sheet. I cannot seem to get it to work using the cell reference to Sheet1, only by typing the actually address into the code - what am I doing wrong? I have tried every imaginable way to accomplish this. The ultimate goal would be to have the picture inserted on the "new sheets" centered just shy of the borders of the merged cell range A7:H30 (Sheet2.range("A7:H30") for reference). Below is the closest I have been able to get to a functioning code, but it ONLY works as it is written below, which is not useful because each new page will have a different directory/address for its picture, hence the use of a cell reference.

Sheet1.Range("TABLE1[MENU ITEM NAME]").COPY
Sheet4.Range("A6").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.DisplayAlerts = True

Dim SHEETCOUNT As Integer
Dim X As Integer
Dim IMGPATH As String

SHEETCOUNT = Sheet1.Range("TABLE1[MENU ITEM NAME]").Rows.COUNT

If SHEETCOUNT > 0 Then
    For X = 1 To SHEETCOUNT
        Sheet2.COPY After:=ActiveWorkbook.Sheets(Worksheets.COUNT)
        ActiveSheet.Range("a4").Value = Sheet1.Range("a" & X).Offset(1, 0).Value
        ActiveSheet.Name = Sheet1.Range("A" & X).Offset(1, 0).Value
        ActiveSheet.PageSetup.CenterFooter = Sheet4.Range("B" & X).Offset(6, 0).Value
        IMGPATH = Sheet1.Range("B" & X).Offset(1, 0).Value '"Z:\Family\Robert\JW\1.jpg" is visible in the editor despite receiving error image cannot be found when using the variable
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 108.75, 476.25, 354.75).Select
        Selection.ShapeRange.Line.Visible = msoFalse
        Selection.ShapeRange.Fill.UserPicture "Z:\Family\Robert\JW\1.jpg"
    Next X
End If

I have uploaded the workbook here for better reference if needed. Please keep in mind this is not finished, so actually trying to some of the codes via buttons may result in errors.

Click here for Workbook

 

[Dan_W]

Hi - I had some difficulty trying to understand what you needed, so was happy to see you had uploaded a workbook. It says that you've deleted it already, though.
Reading your post, I was confused at this:

I am trying to have the picture selected from the form (address/directory for picture is in Sheet1) added (not inserted) to each sheet

When you say "added (not inserted)" - do you mean that you want the images to stay embedded within the workbook, and not just a link, etc? I ask because then you later say:

The ultimate goal would be to have the picture inserted on the "new sheets"

I hadn't expected you to use the AddShape method. Why did you opt for that over the Shapes.AddPicture method? Do you still need help on this? If so, I can take a crack at coming up with a solution.

 

[robertmwaring2]

Thank you for taking the time looking this over. I actually just went with inserting a shape and filled with a pic. It somewhat skews the images, but gets the job done. Thank you for your response though. I appreciate your time.

 

[Dan_W]

You're being far too kind - I was no help whatsoever. I really just wanted to see if you still needed any help.

In terms of the 'skewed element', hopefully the code below can correct that.

Put these two lines with the other Dim lines

        Dim NewImage As Object, Target As Range
        Set Target = Sheet2.Range("A7:H30")

Replace every line from IMGPATH to the last line in the loop (with the UserPicture)

        ImgPath = Sheet1.Range("B" & X).Offset(1, 0).Value
        Set NewImage = Sheet2.Shapes.AddPicture(ImgPath, msoFalse, msoTrue, Target.Left, Target.Top, -1, -1)
        ' Adjust the height OR the width - by default, the picture will retain its dimension ratios
        ' NewImage.Height = 50  or NewImage.Width = 50
        NewImage.Line.Visible = msoFalse

With this code, we've captured the image in the NewImage object. That makes it easier to then manipulate, move around, etc. The parameters (-1, -1) mean to put it in the worksheet in its default size. Once it's there, you can manipulate either its height or width to you preference - by default the picture will retain dimension ratios, so you can really only change one. Is that what you wanted?