Excel VBA 用户表单图片到工作表单元格

Question

I have a question. Is it possible to safe a picure from a workbook userform to a second workbook into a cell.

My code creates a new workbook with a new sheet named newsheet. There I want to insert certain pictures on cell value into the range I am in right now. So far I have something like this:

lrow = newsheet.cells(rows.count,1).end(xlup).rows
for i = 1 to lrow
 if newsheet.range("C" & i) <> "" then 
   'search for name of userfrom, the userfrom name is the same as cell value
     'and insert that picture from that userform into "C" & i
  end if
  next i

Answer 1

There's no easy way to copy the bitmap straight from the UserForm to the Worksheet. Worksheet doesn't have Image objects the way the form has and when adding pictures (either in a Shape, or using ActiveSheet.Pictures.Insert method, the parameter taken is a filename.

That said, you can create a temporary file to save the picture you have in the UserForm and use that file to insert the picture at the location you need.

I created a workbook that has a userform named "TestForm" with one Image control named "Image1" on it.

The following code in a regular module does the trick:

Sub Test()
Dim wb As Workbook
Dim ws As Worksheet
Dim formname As String
Dim tempfile As String

'Create new workbook:
Set wb = Workbooks.Add
Set ws = wb.Sheets(1)

'Setting form name in new sheet. Using row 1 in this example.
ws.Range("C1").Value = "TestForm"

'Retrieve the "found" value
formname = ws.Range("C1").Value

'Save the picture and get the location:
tempfile = SavePictureFromForm(formname)

'Navigate to the correct location, since we need it selected for Pictures.Insert
ws.Activate
Range("C1").Select
'Add the picture to the sheet:
ActiveSheet.Pictures.Insert tempfile

'Clean up the file system:
DeleteTempPicture tempfile
End Sub

Function that saves the picture from the form, provided it's in an Image control named "Image1". Also returns the location to the routine above:

Function SavePictureFromForm(formname As String) As String
Dim tempfilepath As String
Dim tempfilename As String

'Location + filename:
tempfilepath = "C:\Temp\"
tempfilename = "temppicture.jpg"

'Get the correct userform:
Set Obj = VBA.UserForms.Add(formname)

'Save the picture and return it's location:
SavePicture Obj.Image1.Picture, tempfilepath & tempfilename
SavePictureFromForm = tempfilepath & tempfilename

End Function

Delete the temporary file:

Public Sub DeleteTempPicture(filename As String)
'Delete the temporary file throught FSO:
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO
    .DeleteFile filename
End With
Set FSO = Nothing
End Sub

Note that the above has ZERO error handling. If the Name of the form in the cell is invalid, it'll crash. If the form doesn't have an "Image1" control of type image, it'll crash, if you pass an invalid filename to the deletion routine, it'll crash.

However - it does do what you mentioned: Create new workbook, add the picture from a userform in the original workbook to the new workbook (on sheet 1) based on the userform name. Since the question isn't more detailed and your exact use case is unknown, this should be more than sufficient to get you up and running.