PDA

View Full Version : Solved: Clear shapes BUT save buttons



ndendrinos
08-22-2009, 08:38 AM
Hello
I have a sheet setup like this:

shape..............shape................shape

Cmdbutton........Cmdbutton ....Cmdbutton

shape.....shape..............shape


This code clears all ... BUT I would like to clear just the shapes and not the buttons.
Can something be done with this line to preserve the buttons?

sh.TopLeftCell, Rng
Thank you



Dim Rng As Range
Dim sh As Shape
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Set Rng = ws.Range("C1:O3")
For Each sh In ws.Shapes
If Not Intersect(sh.TopLeftCell, Rng) Is Nothing Then sh.Delete
Next sh
Set Rng = Nothing
Set ws = Nothing
The only way I can think of is to keep a copy of the buttons lower in the sheet or in a separate sheet and re-install them each time the code clears all.

Bob Phillips
08-22-2009, 09:27 AM
TRy this



Dim Rng As Range
Dim sh As Shape
Dim ws As Worksheet
Set ws = Worksheets("summary") '"Sheet1")
Set Rng = ws.Range("C1:O3")

For Each sh In ws.Shapes

If Not Intersect(sh.TopLeftCell, Rng) Is Nothing Then

If sh.Type = msoFormControl Then

If sh.FormControlType <> xlButtonControl Then sh.Delete
End If
End If
Next sh
Set Rng = Nothing
Set ws = Nothing

ndendrinos
08-22-2009, 09:59 AM
Sorry xld was having lunch, the code works! (replacing "Sheet summary "with "sheet1")
Thank you

ndendrinos
08-22-2009, 10:27 AM
Again spoke too soon,
xld's code preserves the Cmd buttons as requested but does not clear the cards.

The clearing of the cards dealt in previous hand should occurs each time I click on "Deal New Hand" AND on close thru code "quit"



Thanks

mdmackillop
08-22-2009, 10:56 AM
You could refer to the shape names as in

For Each sh In ws.Shapes
Select Case Left(sh.Name, 4)
Case "Pict" ' and other objects to be preserved.
'do nothing
Else
sh.Delete
End Select
Next sh

ndendrinos
08-22-2009, 11:27 AM
Thank you mdmackillop but the interpretation of your suggestion is way over my understanding.

The cards are pictures with names that change constantly.
The buttons are unique.

My initial code cleared the cards AND the buttons unless the buttons were out of the way (C1:O3)
xld's preserved ALL

Am I to understand that in your reply I would replace "pict" with the buttons I want to preserve?
The Cmd Buttons I guess I can name but how can I give a name to a picture?

Also trying your way I got an error: Else without IF

jolivanes
08-22-2009, 11:53 AM
Would something like this work?

Change Button No's and Text Box accordingly



Sub DeleteTheShapes()
For Each mypicture In ActiveSheet.Shapes
Select Case mypicture.Name
Case "Button 5", "Button 11", "Text Box 36", "Button 48"
' do nothing
Case Else
mypicture.Delete
End Select
Next mypicture
End Sub

ndendrinos
08-22-2009, 12:04 PM
Hello jolivanes, How can I name a picture I downloaded from the Internet? ... the Cmd Buttons have a name but the pixs?
and using your code again I get the dreaded Else without IF

ndendrinos
08-22-2009, 12:14 PM
hold on... hold on ... pixs do have a name ... working on it for your code clears ALL in site except the named one ,,, give me sometime. Thks

ndendrinos
08-22-2009, 12:42 PM
99% all done except for one CmdButton "Dealers_Button" ... don't know why BUT I have to go out for about 1 hour
Thanks

mdmackillop
08-22-2009, 03:22 PM
This will delete any shape having a name starting with "Pict", ensure buttons etc. you wish to keep are named differently
Sub ClearPicts()
Dim sh As Shape
Set ws = ActiveSheet
For Each sh In ws.Shapes
Select Case Left(sh.Name, 4)
Case "Pict" ' and other objects to be preserved.
sh.Delete
Case Else
'do nothing
End Select
Next sh
End Sub

ndendrinos
08-22-2009, 03:25 PM
well the 1% was dealers_button v.s Dealers_Button so that is taken care of.

There is still a problem and it has to do with the range that the code works in. It has to be within "C1:O3"
(The way the code is right now conflicts with the value of the picture in B1)


Sub DeleteTheShapes()
For Each mypicture In ActiveSheet.Shapes
Select Case mypicture.Name
Case "Picture 5611", "Picture 5609", "Picture 866", "Picture 4587", "PlayersButton", "dealers_button", Hit_Button
' do nothing
Case Else
mypicture.Delete
End Select
Next mypicture
End Sub

ndendrinos
08-22-2009, 03:28 PM
Was typing while you posted mdmackillop
Will try this now
Thank you

ndendrinos
08-22-2009, 03:38 PM
same problem mdmackillop you code conflicts with B1
(because the cards are pictures too I guess)

Earlier I tried to create the buttons on open with code but that created problems as well

mdmackillop
08-22-2009, 03:54 PM
Test for postition as well

Sub ClearPicts()
Dim sh As Shape
Set ws = ActiveSheet
For Each sh In ws.Shapes
If sh.Top < Cells(7, 1).Top Then
Select Case Left(sh.Name, 4)
Case "Pict" ' and other objects to be preserved.
sh.Delete
Case Else
'do nothing
End Select
End If
Next sh
End Sub

ndendrinos
08-22-2009, 04:09 PM
I want to thank all of you for helping out I learned something new.

Your last code mdmackillop works.
It still deletes the red buttons for they are pictures and I guess there's no way to rename a picture .

So I will have to create regular excel buttons intead of the fancy ones. Too bad.

I will mark this "Solved" tomorrow just in case a miracle happens overnight.
Best regards to all, Nick

mdmackillop
08-22-2009, 04:19 PM
You can rename a picture by selecting it and changing is name in the Name box, or select it and run

Sub Rename()
Selection.Name = InputBox("Enter new name")
End Sub

ndendrinos
08-22-2009, 05:31 PM
Why is VBA so convoluted ?
I did try to change the picture's name in the Name Box
Right clicked the button ... got Picture 4585 in the Name Box ... highlighted the Picture part...tried to delete it to leave intact 4585 and it did not work ... but now I learn that if one highlights the whole thing and types 4585 it will change.
Thanks again