The Elusive Hiding Button

Visual Basic for Applications · Wikibooks

0%

Contents

    Text

    Size
    100%
    Theme
    Typeface
    Line length
    Spacing

    From Wikibooks, under CC BY-SA 4.0, as the source states it. This page at Wikibooks.

    Summary

    These VBA code modules are intended for Microsoft Excel. They show how to make a button that continually escapes attempts to click it. The code needs only a user form called UserForm1, and two command buttons, CommandButton1 and CommandButton2; The code will size the controls and the form itself.

    Code Notes

    • The MouseMove event applies to specific controls; in this case a CommandButton. It fires whenever the mouse moves anywhere within the area of the control, and is used here to move the control before the user can select it.
    • The code proposes random direction and shift amounts, then checks to make sure that the resulting shift will stay on the form, before moving the control. When a proposed shift is rejected, the fact that the mouse is still moving ensures that another event will still fire before a selection can be made. Selection HAS been known to happen, perhaps when there is an unlikely number of rejected shift values; a click procedure has been included to note the fact, just in case.
    • The VBA help page for this event has an impressive set of options, as yet unexplored here.

    The ThisWorkbook Module

    Copy this code into the ThisWorkbook module of the project. Save the file as xlsm type. It will run whenever the file is opened. 

    Private Sub Workbook_Open()
   'loads the user form at file open
   
   Load UserForm1
   UserForm1.Show

End Sub

    The Userform1 Module

    Copy this code into the UserForm1 module. It can be accessed by double-clicking the userform in design mode. Save the file, making sure it is xlsm type. The code is run by opening the file or by clicking the above Open event procedure in the ThisWorkbook module.

    Code Modifications

    Added colors and overlaps, 2 Feb 2019
    Added notes to code, 2 Feb 2019

    Option Explicit

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, _
            ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'Runs whenever the mouse moves anywhere on the CommandButton control.
    'Shifts the control when that happens, provided that the proposed
    'random shift will still allow the control to stay on the form.
        
    Dim Lrand1 As Long, Lrand2 As Long, Lstartval As Single, LMyrand As Long
    Dim Trand1 As Long, Trand2 As Long, Tstartval As Single, TMyrand As Long
    
    'propose random horizontal jump direction and distance
    Lrand1 = 1 'direction
    Lstartval = Rnd 'fractional
    If Lstartval < 0.5 Then Lrand1 = -1
        Lrand2 = Int((70 - 45 + 1) * Rnd + 45) 'distance
        LMyrand = Lrand1 * Lrand2 'direction and distance
     
    'propose random vertical jump direction and distance
    Trand1 = 1 'direction
    Tstartval = Rnd 'fractional
    If Tstartval < 0.5 Then Trand1 = -1
        Trand2 = Int((70 - 45 + 1) * Rnd + 45) 'distance
        TMyrand = Trand1 * Trand2 'direction and distance
    
    With CommandButton1
        Select Case Lrand1
        Case 1 'positive shift to right
            'if shift still on userform...
            If .Left + LMyrand + .Width < UserForm1.Width + 10 Then
               .Left = .Left + LMyrand 'shift
            Else
               'do nothing - will fire again
            End If
        Case -1 'negative shift to left
            'if shift still on userform...
            If .Left + LMyrand > -10 Then
               .Left = .Left + LMyrand 'shift
            Else
               'do nothing - will fire again
            End If
        End Select
    
        Select Case Trand1
        Case 1 'positive shift down
            'if shift still on userform...
            If .Top + TMyrand + .Height < UserForm1.Height + 10 Then
               .Top = .Top + TMyrand 'shift
            Else
               'do nothing - will fire again
            End If
        Case -1 'negative shift up
            'if shift still on userform...
            If .Top + TMyrand > -10 Then
               .Top = .Top + TMyrand 'shift
            Else
               'do nothing - will fire again
            End If
        End Select
    End With

End Sub

Private Sub CommandButton1_Click()
    'runs if user can select button
    'Rare, but it can happen
    
    MsgBox "It had to happen sometime!"
    
End Sub

Private Sub CommandButton2_Click()
    'runs from alternative choice
    'to stop process and unload form
    
    UserForm1.Hide
    Unload UserForm1

End Sub

Private Sub UserForm_Initialize()
    'runs after loading but before show
    'sets initial values of form and controls
    
    With UserForm1
        .Height = 250
        .Width = 250
        .BackColor = RGB(9, 13, 147)
        .Caption = "Ambitious?..."
    End With
    With CommandButton1
        .Height = 55
        .Width = 55
        .Top = 45
        .Left = 55
        .BackColor = RGB(255, 172, 37)
        .Caption = "Press if" & vbCrLf & "you want" & vbCrLf & "a raise"
    End With
    With CommandButton2
        .Height = 55
        .Width = 55
        .Top = 45
        .Left = 140
        .BackColor = RGB(222, 104, 65)
        .Caption = "No thanks?"
    End With
End Sub

    See Also