Visual Basic for Applications/The Elusive Button
Summary
editThese 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
edit- 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
editCopy 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
editCopy 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
editAdded 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