Reducing the width of command button

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:

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:

Forum statistics

Threads
1,081,537
Messages
5,359,380
Members
400,526
Latest member
Brook1083

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top