这个问题我之前也碰到过，核心矛盾就是模态窗体无法保持置顶复用、非模态窗体容易导致代码逻辑执行时机错误。下面给你一套完整的解决思路和代码，完美匹配你的需求：

一、核心调整思路 #

1. 用非模态方式显示窗体（vbModeless），让窗体可以和Excel工作表交互，同时保持打开状态
2. 绝不使用Unload Me销毁窗体，而是保留窗体实例，这样可以重复点击OK按钮修改坐标
3. 通过Windows API强制窗体置顶，确保它始终在工作表上方不会被遮挡
4. 将“创建矩形+切换工作表”的逻辑移到OK按钮的点击事件里，确保用户输入后才执行

二、具体代码实现 #

1. 在标准模块中添加API声明和主显示过程

先新建一个标准模块（比如Module1），添加以下代码：

' 64位Excel需用PtrSafe，32位可以去掉
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, _
    ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, _
    ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Sub ShowRectangleForm()
    With rect_box
        .StartUpPosition = 0
        ' 让窗体居中显示在屏幕上
        .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
        .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
        .Width = 240
        .Height = 460
        ' 非模态显示窗体，允许同时操作Excel和窗体
        .Show vbModeless
        ' 强制窗体置顶（参数-1表示置于所有窗口最上层）
        SetWindowPos .hwnd, -1, 0, 0, 0, 0, 3
    End With
End Sub

' 创建矩形的专用子过程
Sub CreateRectangle(x1 As Double, y1 As Double, x2 As Double, y2 As Double)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Rectangles")
    
    ' 可选：如果需要每次点击OK都替换旧矩形，取消下面这行注释
    ' On Error Resume Next: ws.Shapes("UserRectangle").Delete: On Error GoTo 0
    
    ' 创建新矩形，自动处理坐标顺序（确保Left/Top是较小值）
    With ws.Shapes.AddShape( _
        Type:=msoShapeRectangle, _
        Left:=Application.Min(x1, x2), _
        Top:=Application.Min(y1, y2), _
        Width:=Abs(x2 - x1), _
        Height:=Abs(y2 - y1))
        .Name = "UserRectangle" ' 给矩形命名，方便后续操作
        .Fill.Transparency = 0.5 ' 可选：设置半透明，方便查看下方内容
    End With
End Sub

2. 修改用户窗体（rect_box）的代码

打开你的用户窗体，找到OK按钮（假设是cmdOK），替换点击事件代码；另外建议添加一个Cancel按钮方便手动关闭窗体：

Private Sub cmdOK_Click()
    Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
    
    ' 输入验证：确保文本框内容是有效数字
    On Error Resume Next
    x1 = CDbl(x1box1.Value)
    y1 = CDbl(y1box2.Value)
    x2 = CDbl(x2box3.Value)
    y2 = CDbl(y2box4.Value)
    On Error GoTo 0
    
    If IsNumeric(x1) And IsNumeric(y1) And IsNumeric(x2) And IsNumeric(y2) Then
        ' 调用创建矩形的过程
        CreateRectangle x1, y1, x2, y2
        
        ' 切换到Rectangles工作表并激活
        With ThisWorkbook.Sheets("Rectangles")
            .Visible = True
            .Activate
        End With
        
        ' 可选：保持当前输入值方便修改，或者清空文本框
        ' x1box1.Value = ""
        ' y1box2.Value = ""
        ' x2box3.Value = ""
        ' y2box4.Value = ""
        
        ' 再次强制窗体置顶，防止被工作表遮挡
        SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
    Else
        MsgBox "请输入有效的数字坐标！", vbExclamation
    End If
    
    ' 关键：不要用Unload Me，保持窗体打开状态
End Sub

' 新增Cancel按钮的点击事件（用于手动关闭窗体）
Private Sub cmdCancel_Click()
    Unload Me
End Sub

三、为什么这样解决问题？ #

• 非模态显示：vbModeless让窗体和Excel可以同时操作，不会像模态窗体那样阻塞后续操作
• 保留窗体实例：不使用Unload Me，窗体一直处于打开状态，用户可以修改坐标后再次点击OK重新生成矩形
• 强制置顶：通过SetWindowPosAPI确保窗体始终在最上层，不会被工作表或其他窗口遮挡
• 逻辑内聚：把创建矩形的逻辑放在OK按钮事件里，只有用户点击OK时才执行，避免了非模态下代码直接跑完的问题

备注：内容来源于stack exchange，提问作者Barbarian