Reducing the width of command button

[cds9892745745]

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

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

 

[Jerry Sullivan]

Maybe a public function that can be called by all your buttons...

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

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

 

[cds9892745745]

Hey JS411,
this works like a charm !

Thanks a ton !