Nov 23 2023 10:43 PM
Sub ChangeShape(ShapeName As String)
Dim CurrentShape As Shape
Dim FName As String
FName = ThisWorkbook.Path & "\tempshape.gif" ' Change the temporary file name
' Set the current shape
Set CurrentShape = ThisWorkbook.Sheets("Animals").Shapes(ShapeName)
' Copy the shape
CurrentShape.Copy
' Add a new picture to the sheet and paste the copied shape
With ThisWorkbook.Sheets("Animals").Pictures.Paste
' Export the pasted picture as a GIF
.Export Filename:=FName, FilterName:="GIF"
End With
' Load the exported picture to the TableImage on the AnimalTimeData Userform
AnimalTimeData.TableImage.Picture = LoadPicture(FName)
End Sub
Can anyone help me with this code. The property is not supported for shapes. I want to import a shape in an image of my VBA UserForm in excel. The shape is in the excel sheet. The shape must be dynamically update therefore the sub ChangeShape.
Nov 23 2023 11:43 PM
It seems like you are trying to copy a shape from a worksheet, export it as a GIF file, and then load that GIF into an Image control on a UserForm. However, the Picture property is not supported for shapes, and exporting a shape directly as an image might be a bit tricky.
One workaround is to capture a screenshot of the shape and save it as an image.
Here is an example of how you might modify your code:
Vba code (is untested):
Sub ChangeShape(ShapeName As String)
Dim CurrentShape As Shape
Dim FName As String
Dim UF As AnimalTimeData
' Set the current shape
Set CurrentShape = ThisWorkbook.Sheets("Animals").Shapes(ShapeName)
' Set the userform
Set UF = AnimalTimeData
' Capture a screenshot of the shape
CurrentShape.CopyPicture
' Add a new picture to the sheet and paste the copied shape
With ThisWorkbook.Sheets("Animals").Pictures.Paste
' Export the pasted picture as a GIF
FName = ThisWorkbook.Path & "\tempshape.gif" ' Change the temporary file name
.ShapeRange.ExportAsFixedFormat Type:=xlTypeGIF, Filename:=FName
End With
' Load the exported picture to the Image control on the AnimalTimeData UserForm
UF.TableImage.Picture = LoadPicture(FName)
End Sub
In this modification, the CopyPicture method is used to capture the shape as it appears on the sheet, and then it is saved as a GIF file. The ExportAsFixedFormat method is used to save the picture as a GIF file.
Make sure that you have an Image control named TableImage on your AnimalTimeData UserForm.
Please note that capturing the shape as it appears on the sheet might not be as precise as exporting the shape directly. If you have complex shapes with gradients or special effects, the result may not be perfect.
Test this code in your specific environment, and adjust it as needed for your application.
AI was partially deployed to support the text.
My answers are voluntary and without guarantee!
Hope this will help you.
Was the answer useful? Mark as best response and Like it!
This will help all forum participants.
Nov 24 2023 10:55 AM
Nov 24 2023 11:35 PM
Alternative you can use the Copy method to copy the shape to the Clipboard and then use a workaround to save it as an image. Below is an updated version of your code:
vba Code (is untested):
Sub ChangeShape(ShapeName As String)
Dim CurrentShape As Shape
Dim FName As String
Dim UF As AnimalTimeData
' Set the current shape
Set CurrentShape = ThisWorkbook.Sheets("Animals").Shapes(ShapeName)
' Set the userform
Set UF = AnimalTimeData
' Copy the shape to the Clipboard
CurrentShape.Copy
' Create a new temporary chart to paste the shape
With ThisWorkbook.Sheets.Add
.Shapes.AddChart2(251, xlColumnClustered).Select
.Paste
End With
' Export the pasted chart as a GIF
FName = ThisWorkbook.Path & "\tempshape.gif" ' Change the temporary file name
ActiveChart.Export Filename:=FName, FilterName:="GIF"
' Delete the temporary sheet
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
' Load the exported picture to the Image control on the AnimalTimeData UserForm
UF.TableImage.Picture = LoadPicture(FName)
End Sub
In this code:
Please replace "xlColumnClustered" with the appropriate chart type that suits your needs. Test this code and see if it meets your requirements.