If you can double click on the cell (assumes that the picture doesn't cover the
whole cell):

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)

Dim myPic As Picture
Dim PictName As String
Dim myRng As Range

PictName = "C:\Program Files\media\office10\Bullets\BD21301_.gif"

If Target.Cells.Count 1 Then Exit Sub
If Intersect(Target, Me.Range("h:h")) Is Nothing Then Exit Sub

Application.EnableEvents = False
If Target.Value = "" Then
Target.Value = 1
ElseIf Target.Value = 1 Then
Target.Value = ""
End If
Application.EnableEvents = True

For Each myPic In Me.Pictures
Set myRng = Me.Range(myPic.TopLeftCell, myPic.BottomRightCell)
If Intersect(myRng, Target) Is Nothing Then
'do nothing
Else
myPic.Delete
End If
Next myPic

If Target.Value = 1 Then
Set myPic = Me.Pictures.Insert(PictName)
With Target
myPic.ShapeRange.LockAspectRatio = msoTrue
myPic.Height = .Height
myPic.Left = .Left + (Target.Width - myPic.Width) / 2
End With
End If
End Sub


There are other ways of putting a checkbox on a worksheet--you could use a
checkbox from the Forms toolbar or a checkbox from the control toolbox toolbar.

How about another option?

Format your column of cells in a nice way:
Format|cells|number tab|custom category
In the "type:" box, put this:
alt-0252;alt-0252;alt-0252;alt-0252

But hit and hold the alt key while you're typing the 0252 from the numeric
keypad.

It should look something like this when you're done.
ü;ü;ü;ü
(umlaut over the lower case u separated by semicolons)

And format that range of cells as Wingdings.

Now, no matter what you type (spacebar, x, anyoldtextatall), you'll see a check
mark.

Hit the delete key on the keyboard to clear the cell.

If you have to use that "checkmark" in later formulas:

=if(a1="","no checkmark","Yes checkmark")


aftamath wrote:

That coding looks like what I'm looking for. How do I incorporate in my code
below so that if I double click a cell in column "H", it removes the picture
above that cell? And how do I center the picture in the cell horizontally
and vertically?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Cancel = True

Dim myPic As Picture

If Target.Column = 8 Then
If Target.Value = "" Then
Target.Value = 1
ElseIf Target.Value = 1 Then
Target.Value = ""
End If
If Target.Value = 1 Then
ActiveSheet.Pictures.Insert("C:\Program
Files\media\office10\Bullets\BD21301_.gif").Select
Selection.ShapeRange.IncrementLeft 19.25
Selection.ShapeRange.IncrementTop 1.9
Target.Select
ElseIf Target = "" Then
For Each myPic In ActiveSheet.Pictures
End If
End If

End Sub

"Dave Peterson" wrote:

You could cycle through all the pictures looking for where they are. If they're
over your cell, then delete it.

Option Explicit
Sub testme()

Dim myCell As Range
Dim myRng As Range
Dim myPic As Picture

With ActiveSheet
Set myCell = .Range("F14")
For Each myPic In .Pictures
Set myRng = .Range(myPic.TopLeftCell, myPic.BottomRightCell)
If Intersect(myRng, myCell) Is Nothing Then
'do nothing
Else
myPic.Delete
'Exit For 'if there's always only one picture to delete
End If
Next myPic
End With

End Sub

aftamath wrote:

Is it possible to delete a picture or shape from a worksheet using VBA by
referencing the cell that it is placed on?

I have a few pictures on a sheet, placed there by referencing certain cells.
I'm trying to right a few arguments in excel, and depending on the boolean,
I would like the picture removed from the cell. Any suggestions would be
great.

--

Dave Peterson


--

Dave Peterson