應用程式 VBA/難以捉摸的按鈕
< 應用程式 VBA
這些 VBA 程式碼模組適用於 Microsoft Excel。它們展示瞭如何製作一個不斷逃避點選嘗試的按鈕。程式碼只需要一個名為 _UserForm1_ 的使用者窗體，以及兩個命令按鈕 _CommandButton1_ 和 _CommandButton2_；程式碼將調整控制元件和窗體本身的大小。
- MouseMove 事件適用於特定控制元件；在本例中為命令按鈕。它在滑鼠在控制元件區域內任何地方移動時觸發，此處用於在使用者選擇控制元件之前移動控制元件。
- 程式碼提出隨機方向和偏移量，然後檢查以確保最終偏移會停留在窗體上，然後再移動控制元件。當提出的偏移被拒絕時，由於滑鼠仍在移動，因此在選擇之前仍會觸發另一個事件。已知選擇會發生，可能是在遇到數量不多的拒絕的偏移值時；已包含一個點選過程來記錄這一事實，以防萬一。
- 此事件的 VBA 幫助頁面包含一組令人印象深刻的選項，此處尚未探索。
將此程式碼複製到專案的 ThisWorkbook 模組中。將檔案儲存為 _xlsm_ 型別。它將在檔案開啟時執行。
Private Sub Workbook_Open()
'loads the user form at file open
Load UserForm1
UserForm1.Show
End Sub
將此程式碼複製到 UserForm1 模組中。可以透過在設計模式下雙擊使用者窗體來訪問它。儲存檔案，確保它是 _xlsm_ 型別。程式碼透過開啟檔案或單擊上面的 _Open 事件_ 過程在 _ThisWorkbook_ 模組中執行。
新增顏色和重疊，2019 年 2 月 2 日
新增程式碼說明，2019 年 2 月 2 日
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