AutoCAD VBA模态窗体焦点问题-2

 

Option Explicit
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public Const WS_POPUP = &H80000000
Public Const GWL_STYLE = (-16)
Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

 

Option Explicit
Public reg As RegExp, mcols As MatchCollection, m As Match


Private Sub UserForm_Initialize()
    If reg Is Nothing Then
        Set reg = New RegExp
        reg.Pattern = "\d+$"
    End If
    Dim hd, s As Long
    hd = Win32Api.FindWindow(vbNullString, Me.Caption)
    s = Win32Api.GetWindowLong(hd, Win32Api.GWL_STYLE)
    If s And Win32Api.WS_POPUP = Win32Api.WS_POPUP Then
        s = s Xor Win32Api.WS_POPUP
        Win32Api.SetWindowLong hd, Win32Api.GWL_STYLE, s
    End If
End Sub

Private Sub CommandButton1_Click()
    Dim t As String, str As String, lastVal As Long
    t = Me.TextBox1.Text
    str = reg.Replace(t, "")
    Set mcols = reg.Execute(t)
    If mcols.count > 0 Then
        Set m = mcols.Item(0)
        lastVal = VBA.CLng(m.value)
    Else
        lastVal = 0
    End If
    Me.TextBox1 = str & (lastVal + 1)
End Sub

Private Sub UserForm_Terminate()
    Set m = Nothing: Set mcols = Nothing: Set reg = Nothing
End Sub

 

Public Sub Mycmd_测试窗体()
    UserForm1.show 0
End Sub

视频效果：

AutoCAD VBA 模态窗体焦点解决办法_哔哩哔哩_bilibili