Deleting Shapes

A

aftamath

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.
 
D

Dave Peterson

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
 
A

aftamath

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
 
D

Dave Peterson

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")
 
A

aftamath

Hey dave, thanks for the info on this. Very useful. I used the option at
the bottom. But, I can't seem to get VBA to recognize that there is a check
mark in the cell containing this type of symbol. What exactly is the
"ü;ü;ü;ü". How does VBA recognize this. Thanks.

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.
 
D

Dave Peterson

By using that custom format, you don't need to look at the value in the cell.
You just need to look to see if there's something in there.

if activesheet.range("a1").value = "" then
'not checked
else
'is checked
end if

If you give that cell that custom format, then no matter what you type in that
cell, you'll see the checkmark--You can type an X, a space character, a dot or
even a paragraph of 3000 characters. You'll see the same checkmark.
 
Top