cds9892745745

New Member
Joined
Sep 2, 2009
Messages
9
Hi,
i want o make some command buttons on a sheet with the width 50 and when you move the mouse over to any one the width of that one should increase to 300. when you move he mouse over to the other one the size of the previous one should return to 50 and the new one (now under the mouse) should be 300.

i have written the code for it how ever it tends to increase the width twice i.e.
it will increase the size of the command button, then reduce it to 50 and increase it again. this action makes it look like it flickering

Please Help !

Code below

Code:
Option Explicit

Dim sShapes As Shape
Dim ActShapes As Shape
Dim wsStart As Worksheet, WsNew As Worksheet
Dim wd
Dim mybutton
Dim ShapeChk As Boolean



Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Application.ScreenUpdating = False
Set wsStart = ActiveSheet
For Each sShapes In wsStart.Shapes
With sShapes
 .Width = 50
End With
Next sShapes
wd = ActiveSheet.Shapes("CommandButton1").Width

Do Until wd >= 300
    wd = wd + 50
Application.ScreenUpdating = True
ActiveSheet.Shapes("CommandButton1").Width = wd 'msoFalse, msoScaleFromBottomRight
Application.ScreenUpdating = False
Loop
Application.ScreenUpdating = True
End Sub


Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Application.ScreenUpdating = False
Set wsStart = ActiveSheet
For Each sShapes In wsStart.Shapes
With sShapes
 .Width = 50
End With
Next sShapes

wd = ActiveSheet.Shapes("CommandButton2").Width
Do Until wd >= 300
    wd = wd + 50
    Application.ScreenUpdating = True
ActiveSheet.Shapes("CommandButton2").Width = wd 'msoFalse, msoScaleFromBottomRight
Application.ScreenUpdating = False
Loop
Application.ScreenUpdating = True
End Sub
 
Last edited:

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Maybe a public function that can be called by all your buttons...

Code:
Public Function Resize_Buttons(sButtonName As String)
    Dim shpShape As Shape
  
    For Each shpShape In ActiveSheet.Shapes
        With shpShape 
            If .Width <> 50 Then .Width = 50
        End With
    Next shpShape 
    With ActiveSheet.Shapes(sButtonName)
        .Width = 300
    End With
End Function

Calling event procedures...
Code:
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, _
        ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Resize_Buttons ("CommandButton1")
End Sub

Private Sub CommandButton2_MouseMove(ByVal Button As Integer, _
        ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Resize_Buttons ("CommandButton2")
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top