应用程序 VBA/难以捉摸的按钮

摘要

这些 VBA 代码模块适用于 Microsoft Excel。它们展示了如何制作一个不断逃避点击尝试的按钮。代码只需要一个名为 _UserForm1_ 的用户窗体，以及两个命令按钮 _CommandButton1_ 和 _CommandButton2_；代码将调整控件和窗体本身的大小。

代码说明

• MouseMove 事件适用于特定控件；在本例中为命令按钮。它在鼠标在控件区域内任何地方移动时触发，此处用于在用户选择控件之前移动控件。
• 代码提出随机方向和偏移量，然后检查以确保最终偏移会停留在窗体上，然后再移动控件。当提出的偏移被拒绝时，由于鼠标仍在移动，因此在选择之前仍会触发另一个事件。已知选择会发生，可能是在遇到数量不多的拒绝的偏移值时；已包含一个点击过程来记录这一事实，以防万一。
• 此事件的 VBA 帮助页面包含一组令人印象深刻的选项，此处尚未探索。

ThisWorkbook 模块

将此代码复制到项目的 ThisWorkbook 模块中。将文件保存为 _xlsm_ 类型。它将在文件打开时运行。

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

End Sub

Userform1 模块

将此代码复制到 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