Visual Basic for Applications/The Elusive Button

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