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

时间:2018-10-02 08:27:58

标签: excel vba excel-vba

我有一个问题。从工作簿用户表单到第二个工作簿到单元格中的图片是否可能安全。

我的代码使用名为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

1 个答案:

答案 0 :(得分:0)

没有简单的方法将位图直接从UserForm复制到工作表。工作表没有表单所具有的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

请注意,以上内容具有错误处理。如果单元格中表单的名称无效,它将崩溃。如果表单没有image类型的“ Image1”控件,它将崩溃,如果将无效的文件名传递给删除例程,它将崩溃。

但是-它确实做了您提到的事情:创建新工作簿,根据用户表单名称将原始工作簿中用户表单中的图片添加到新工作簿中(在工作表1中)。由于问题没有更详细,并且您的确切用例未知,因此足以使您正常运行。