Create Drop Down List to Display Shapes in Excel
How to create drop down list using data validation to display shapes in Excel with a macro. More details available here: https://www.exceltrainingvideos.com/c...
Here's the complete macro code:
Sub CreateDropDownListWithShapes()
' CreateDropDownListWithSDhapes Macro
' How To Create Drop Down List With Shapes In Excel
DeletePicture
Range("F2").Clear
Range("F2").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$A$2:$A$4"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("F2") = "Circle"
ActiveSheet.Shapes.Range(Array("Oval 9")).Select
Selection.Copy
Range("G2").Select
ActiveSheet.Pictures.Paste.Select
Selection.ShapeRange.IncrementLeft 8.25
Selection.ShapeRange.IncrementTop 9.75
Selection.Formula = "=MyShapes"
Selection.ShapeRange.ScaleWidth 1.208488429, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.208488429, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft -6.75
Selection.ShapeRange.IncrementTop -7.5
Range("F2").Select
End Sub
Sub DeletePicture()
Dim myObj
Dim Pictur
Set myObj = ActiveSheet.DrawingObjects
For Each Pictur In myObj
If Left(Pictur.Name, 6) = "Pictur" Then
Pictur.Select
Pictur.Delete
End If
Next
End Sub
