Commandbutton loses transparency

[freeofcost]

Hello

I have inserted a CommandButton from ActiveX controls in Sheet1 (Not in userforms). I have placed the button on cell A1 and made its backstyle transparent so that the value in A1 is always visible and user should not come to know that there is a button in there.

Now when I click it, it loses transparency. so what I did was, I wrote ActiveSheet.OLEObjects("CommandButton1").Object.BackStyle = fmBackStyleTransparent in the CommandButton1_Click() event but it did not help so I kept the code under GotFocus() event with no help.

How can I keep the transparency of the button permanent on all events (click, got/lost focus, mouse up/down etc?

Thank you.

[freeofcost]

To explain it better, I have attached a sample file. where I have taken two approaches.
1. There are four cells that takes a color when the cell is clicked. This is to show the user which cell is selected
2. There are four buttons (i have added only one button). When the user clicks on the button, it loses transparency.

I do not want to go with the first approach because, everytime a cell is clicked, the macro will run which will eat of system resources. That is why I wanted to go with the second approach but the problem is transparency and the look of the button. It should retain transparency so that the text behind the button is always visible and the button should be flat so that user should not come to know that there is a button in there. I can do this by changing the caption of the button on click but I do not want to go with that for some reasons.

I request some help here. Thanks

[nilem]

Hi freeofcost,
try this

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("B2,B4,B6,B8")) Is Nothing Then Exit Sub
If Range("D2").Value = "No" Then Exit Sub
Range("B2,B4,B6,B8").Interior.Color = xlNone
Target.Interior.Color = 14281213
End Sub

It does not load the system
or use AutoShapes (see. the attachment)

[freeofcost]

Now thats what I call efficiency... Intersect is something I learned new today.
I am going with the AutoShapes approach.... thank you so much.

[freeofcost]

Hello,

I am running into one more problem. Please refer the revised attachment:
If cell E2 value is set to 'Yes', clicking any button (shape) colors the corresponding cell and re-click removes the color. I have added one more condition at cell F2. Present number is 1, if the number is changed to 2, it should allow the user to color two cells by clicking any two buttons and if the user clicks on third button, it should remove the color of the cell corresponding to the button the user clicked first.

I may have used a long method to achieve what I have done so far and some part is pending. There may be a better or efficient way of doing it. Please advice.

Thanks

[nilem]

Hi freeofcost,
try this

Sub ertert()
With ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, -2)
    If .Interior.Color = vbGreen Then
        .Interior.Color = xlNone: .ClearContents
    Else
        If Range("F2").Value = "Yes" Then
            With Range("B2:B8")
                If WorksheetFunction.Sum(.Value) >= Range("G2").Value Then _
                   .Interior.Color = xlNone: .ClearContents
            End With
            .Interior.Color = vbGreen: .Value = 1
        End If
    End If
End With
End Sub

[freeofcost]

You know what! I was breaking my head over this since a couple of days. It is difficult for me to believe that this can be done in mere few lines of code. You rock man!

I am going to spend time on understanding how the code is getting executed and then going to come up with a different scenario and do it myself. I will come back to you if I need help. Thank you so much.

[freeofcost]

I am going to spend time on understanding how the code is getting executed and then going to come up with a different scenario and do it myself. I will come back to you if I need help. Thank you so much.

What I understood so far is that the application.caller with an offset detects the cell and puts a number '1' in it and then the sum function is used to calculate how many cells contain number '1' and match with the condition in cell G2. Wow! thats a wonderful logic (I hope I have understood correctly)

Now if I move Shapes or put the buttons horizontally, the code stops working.... I guess because of SET offsets and the range Range("B2:B8"). I have changed the scenario a bit and altered the code. however, it does not work and only one column is getting selected. I think I have not understood the TopLeftCell property well.

Can you please have a look at the code? I have updated the attached file with the instructions. There are two sheets in it "Working" and "Not Working"

Thank you

Sub ertertNotWorking()
With ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(-2, 0)
    If .Interior.Color = vbGreen Then
        .Interior.Color = xlNone: .Offset(-1, 0).ClearContents
    Else
        If Range("F2").Value = "Yes" Then
            With Range("B3:D5")
                If WorksheetFunction.Sum(.Value) >= Range("G2").Value Then _
                   .Interior.Color = xlNone: .Offset(-1, 0).ClearContents
            End With
            .Interior.Color = vbGreen: .Offset(-1, 0).Value = 1
        End If
    End If
End With
End Sub

[nilem]

Hi freeofcost,
look at the attached file

[freeofcost]

Hello Nilem,

Thank you for your reply. As mentioned in my earlier attached file, the text written inside the cell should be visible and should not be deleted. The reason is that there is formula inside and the values are coming from somewhere. I was looking for a solution without deleting the text inside the cells. I worked on the code a bit and I guess it should work but for some reason everytime cell C6 gets selected after the Application.Caller.TopLeftCell command. I am still using the SUM approach by changing the cell range.

Updated file attached with an added worksheet 'ShouldWork'. The gray colored cells are safe cells and can be used but C4, F4, C6, F6 should not be deleted.

Moreover,
I was initially going with the 'CommandButtons' and since it was not getting transparent and after your advice, I switched to 'Shapes' Now I am having difficulty in getting unique names of the 4 Shapes that we added. I tried ActiveSheet.Shapes("Rectangle 1").select, Rounded Rectangle, Textbox etc. I also tried a For Each myshape In ActiveSheet.Shapes loop but unable to get the name.

Why I am doing this is because once the above issue is resolved, my next activity is to show/hide shapes with the .visible property. Infact in the past couple of hours, I was trying to write a new code to hide shapes on what is selected in 'H4' and 'I4' For example, if 'H4' contains 'M1' and 'I4' contains 2, the macro should hide 2 random shapes out of (M2, M3, M4) except M1 Similarly, if 'H4' contains 'M3" and 'I4' contains 1, the macro should hide 1 random shape out of (M1, M2, M4) except M3

Thank you.

[nilem]

Hi freeofcost,
see attachment

[freeofcost]

Thank you Nilem,

1. I made a blunder in With(Range) and SUM range. Also, I must say that i need to practice offsets.
(a) Wanted to ask one more thing - Did you move or changed alignment of the shapes?


2. Regarding shape names, I wrote a similar code as you except for the visible property to false then why wasn't I getting the names?
(a) did you change the shapes properties somewhere or what exactly you did to make it work?
(b) Also, I am getting the names in some special characters. Any reason for this? Here are the names...

Прямоугольник 105
Прямоугольник 106
Прямоугольник 107
Прямоугольник 108

Your code

Sub chkShapesName()
Dim i As Integer
i = 26
Dim myshape As Shape
For Each myshape In ActiveSheet.Shapes
    myshape.Visible = msoFalse
    Cells(i, 11).Value = myshape.Name
    i = i + 1
'    myshape.Visible = msoTrue
Next myshape
End Sub

My Code

Sub chkShapesName()
Dim i As Integer
i = 20
    Dim myshape As Shape
    For Each myshape In ActiveSheet.Shapes
    myshape.Visible = msoFalse
        Range("A" & i).Value = myshape.Name 'myshape.OLEFormat.Object.name
        i = i + 1
    Next myshape
End Sub

[nilem]

Your code (your "My Code") works for me. I got 79 names of shapes on the "ShouldWork" sheet.
So I deleted all the shapes and put 4 new rectangles. In the Russian version they take local names Прямоугольник (this is not the special characters, this is Russian language). You can change this name in the "Name" field (top left)

[freeofcost]

Your code (your "My Code") works for me. I got 79 names of shapes on the "ShouldWork" sheet.

Surprisingly, my code did not produce result for me. I did got 80 names but all names were same... may be because i may have not named it on top left.

In the Russian version they take local names Прямоугольник (this is not the special characters, this is Russian language).

I am so sorry... i never saw something like this in the past hence i thought it was special characters

You can change this name in the "Name" field (top left)

I searched everywhere, format shapes, size and properties and dont even remember where but forgot looking at the top left... phew!

Thank you !!!