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 上）。 由於問題不是更詳細，並且您的確切用例未知，因此這應該足以讓您啟動並運行。