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:

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
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:

Watch MrExcel Video

Forum statistics

Threads
1,118,877
Messages
5,574,775
Members
412,617
Latest member
mlharris
Top