是否可以在不首先保存到磁盘的情况下使用UserForm中的图像?保存到磁盘会大大增加代码执行时间,并会造成混乱,我必须清理。
编辑: 这是托管在我的Google云端硬盘中的示例项目: https://drive.google.com/open?id=11bko1qPI30DuN0_MtMRAmhmYYpu6lBb4
此示例应打开一个用户窗体窗口,使您可以:
' ------------------------------------------------------
' Name: multiImageTest
' Kind: Form
' Purpose: Test the time spent updating images on a UserForm
' Author: Dave
' Date: 1/18/2019
' ------------------------------------------------------
Option Explicit
Private testSheet As Worksheet
Private images As Collection
Private tempImagePath As String
' ----------------------------------------------------------------
' Procedure Name: createImg
' Purpose: Create the image control on the UserForm
' Procedure Kind: Function
' Procedure Access: Private
' Parameter image (Long): Used to name the control
' Return Type: image
' Author: Dave
' Date: 1/18/2019
' ----------------------------------------------------------------
Private Function createImg(ByVal image As Long) As MSForms.image
' The Id the image will use
Dim imgId As String: imgId = "img" + CStr(image)
' Create the image on the UserForm
Set createImg = Me.Controls.add("Forms.Image.1", imgId)
With createImg
.top = 0
.left = ((image - 1) * 100) + 10
.width = 100
.height = 40
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeZoom
.PictureTiling = False
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleOpaque
.BackColor = RGB(0, 0, 0) ' black
.BorderColor = RGB(240, 240, 240) ' almost white
End With
' Create the load time label on the UserForm
Dim lblLoadTime As MSForms.label
Set lblLoadTime = Me.Controls.add("Forms.Label.1", imgId + "_loadTime")
With lblLoadTime
.top = 40
.left = ((image - 1) * 100) + 10
.width = 100
.height = 15
.caption = "..."
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
.BorderColor = RGB(0, 0, 0) ' almost white
End With
End Function
' ----------------------------------------------------------------
' Procedure Name: btnGo_Click
' Purpose: Start execution
' Procedure Kind: Sub
' Procedure Access: Private
' Author: Dave
' Date: 1/18/2019
' ----------------------------------------------------------------
Private Sub btnGo_Click()
Set testSheet = ActiveWorkbook.Worksheets(Me.cbSheetChoice.value)
Dim area As range: Set area = testSheet.range("A1:C3")
' Put some random numbers in each cell
execute area
End Sub
' ----------------------------------------------------------------
' Procedure Name: execute
' Purpose: Do the stuff
' Procedure Kind: Sub
' Procedure Access: Private
' Parameter area (range): The area to take an image
' Author: Dave
' Date: 1/18/2019
' ----------------------------------------------------------------
Private Sub execute(ByRef area As range)
Dim startTime As Double
Dim secondsElapsed As Double
Dim tmpImage As MSForms.image
Dim lblLoadTime As Control
Dim image As Long
Dim row As Long
Dim column As Long
' Fill in the cells with some numbers
For image = 1 To 5
For row = 1 To 3
For column = 1 To 3
' So Rnd gives us a random number each time
Randomize
area.Cells(row, column).value = Rnd(10)
Next column
Next row
'Remember time
startTime = Timer
' Creat the image and load Time Label
Set tmpImage = createImg(image)
Set lblLoadTime = Me.Controls.item("img" + CStr(image) + "_loadTime")
' Set the picture path on the userform object
tmpImage.Picture = LoadPicture(getFile(area, image))
' Add to collection
images.add tmpImage
' Set the load time amount
lblLoadTime.caption = CStr(Round(Timer - startTime, 5)) + "s"
Next image
End Sub
' ----------------------------------------------------------------
' Procedure Name: getFile
' Purpose: Get the File path of the newly generated image
' Procedure Kind: Function
' Procedure Access: Private
' Parameter area (range): The area to create an image from
' Parameter image (Long): Used to name the file
' Return Type: String
' Author: Dave
' Date: 1/18/2019
' ----------------------------------------------------------------
Private Function getFile(ByRef area As range, ByVal image As Long) As String
Dim fileName As String: fileName = "tempImg" + CStr(image) + ".jpg"
' Copy the image to the clipboard
area.CopyPicture xlPrinter, xlPicture
With testSheet
.activate
' Create the chart object
Dim chtObj As ChartObject
Set chtObj = .ChartObjects.add(image * 150, 0, area.width, area.height)
' Name it for easy reference
chtObj.name = fileName
' Resize obj to picture size (otherwise it will be skewed)
chtObj.width = area.width
chtObj.height = area.height
' Activate the chart so we can work with it, then paste the copied range
.ChartObjects(fileName).activate
ActiveChart.Paste
' Export the file
ActiveChart.Export fileName:=tempImagePath + fileName
' Delete the temporary chart object
chtObj.delete
End With
getFile = tempImagePath + fileName
End Function
' ----------------------------------------------------------------
' Procedure Name: UserForm_Initialize
' Purpose: Init the UserForm
' Procedure Kind: Constructor (Initialize)
' Procedure Access: Private
' Author: Dave
' Date: 1/18/2019
' ----------------------------------------------------------------
Private Sub UserForm_Initialize()
' Add each Worksheet name to the dropdown box
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Me.cbSheetChoice.AddItem ws.name
Next ws
' Set the default dropdown choice to the first Sheet
Me.cbSheetChoice.ListIndex = 0
' Init the images collection
Set images = New Collection
' Set the temporary image path
tempImagePath = application.ActiveWorkbook.path + application.PathSeparator
Me.lblTempImagePath.caption = tempImagePath
End Sub