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

Question

我有个问题。 是否可以将工作簿用户表单中的图片安全地保存到单元格中的第二个工作簿中。

我的代码使用名为 newsheet 的新工作表创建了一个新工作簿。 在那里，我想将单元格值上的某些图片插入到我现在所在的范围中。 到目前为止，我有这样的事情：

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

没有简单的方法可以将位图直接从UserForm复制到工作表。 Worksheet 没有像表单那样具有Image对象，并且在添加图片时（在 Shape 中，或使用ActiveSheet.Pictures.Insert方法，采用的参数是文件名。

也就是说，您可以创建一个临时文件来保存用户窗体中的图片，并使用该文件将图片插入到您需要的位置。

我创建了一个工作簿，它有一个名为“TestForm”的用户窗体，上面有一个名为“Image1”的图像控件。

常规模块中的以下代码可以解决问题：

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

保存窗体中图片的函数，前提是它位于名为“Image1”的 Image 控件中。 还将位置返回到上面的例程：

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

删除临时文件：

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

请注意，上面有零错误处理。 如果单元格中表单的名称无效，它将崩溃。 如果表单没有图像类型的“Image1”控件，它将崩溃，如果您将无效的文件名传递给删除例程，它将崩溃。

但是 - 它确实执行您提到的操作：创建新工作簿，根据用户表单名称将原始工作簿中用户表单中的图片添加到新工作簿（在工作表 1 上）。 由于问题不是更详细，并且您的确切用例未知，因此这应该足以让您启动并运行。