vba 用 API 异步关闭 ，打开的对话框

perfect131

        虽然有点偏们，但我相信在某个时刻派上用场

        当 vba 执行这段代码 Application.Dialogs(xlDialogPrintPreview).Show，当你不手动关闭 或者 ESC 时，后面的代码不能执行，这个时候怎么办？？
       sendkeys "{ESC}" 这个会让数字键盘失效，手动按 NUMLOCK才开启，不能每次手动按NUMLOCK
       这个时候用到 vbs 关闭 或者 API 异步关闭，API 异步关闭如下：
      1. API 异步关闭 打印预览对话框
   

1. #If VBA7 Then
   
2.     Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
   
3.     Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal uIDEvent As Long) As Long
   
4. #Else
   
5.     Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
   
6.     Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal uIDEvent As Long) As Long
   
7. #End If
   
8. Sub kong()
   
9.     '''异步关闭窗口
   
10.     Call ClosePrintPreview(Close_In_HowMany_Seconds_FromNow:=0) '<== Close PPreview in 0 sconds - Change argument value to suit
    
11.     '''打印预览对话框
    
12.     Application.Dialogs(xlDialogPrintPreview).Show
    
13. End Sub
    
14. Private Sub ClosePrintPreview(ByVal Close_In_HowMany_Seconds_FromNow As Long)
    
15.     Call SetTimer(Application.hwnd, 0, Abs(Close_In_HowMany_Seconds_FromNow) * 1000, AddressOf CloseNow)
    
16. End Sub
    
17. Private Sub CloseNow()
    
18.     With Application
    
19.         Call KillTimer(.hwnd, 0)
    
20.         If .CommandBars.GetEnabledMso("PrintPreviewClose") Then
    
21.             .CommandBars.ExecuteMso ("PrintPreviewClose")
    
22.         End If
    
23.     End With
    
24. End Sub

复制代码

        2.API 异步关闭 Application.Dialogs(xlDialogFormulaFind).Show , 2, 2

1. #If VBA7 Then
   
2.     Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
   
3.     Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal uIDEvent As Long) As Long
   
4.     Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
   
5.                                                           ByVal bScan As Byte, _
   
6.                                                           ByVal dwFlags As Long, _
   
7.                                                           ByVal dwExtraInfo As LongPtr)
   
8. #Else
   
9.     Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
   
10.     Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal uIDEvent As Long) As Long
    
11.     Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    
12. #End If
    
13. Const KEYEVENTF_KEYUP = &H2
    
14. Const VK_ESCAPE = &H1B
    
15. Sub kong()
    
16.     '''异步关闭窗口
    
17.     Call ClosePrintPreview(Close_In_HowMany_Seconds_FromNow:=0) '<== Close PPreview in 0 sconds - Change argument value to suit
    
18.     '''不用遍历工作表，整个工作簿替换
    
19.     Application.Dialogs(xlDialogFormulaFind).Show , 2, 2
    
20.     ThisWorkbook.Activate
    
21.     '''被替换 What  ，，新内容 Replacement
    
22.     Cells.Replace What:="bbb", Replacement:="aaa", LookAt:=xlPart, SearchOrder _
    
23.         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
24. End Sub
    
25. Private Sub ClosePrintPreview(ByVal Close_In_HowMany_Seconds_FromNow As Long)
    
26.     Call SetTimer(Application.hwnd, 0, Abs(Close_In_HowMany_Seconds_FromNow) * 1000, AddressOf CloseNow)
    
27. End Sub
    
28. Private Sub CloseNow()
    
29.     Call KillTimer(Application.hwnd, 0)
    
30.     '按下 ESC
    
31.     keybd_event VK_ESCAPE, 0, 0, 0
    
32.     '释放 ESC
    
33.     keybd_event VK_ESCAPE, 0, KEYEVENTF_KEYUP, 0
    
34. End Sub

复制代码

一般 ESC 就能 关闭 关闭对话框了

perfect131

   https://club.excelhome.net/thread-1649300-1-1.html
   https://club.excelhome.net/forum ... 657144&pid=11212736
   https://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=1658415&pid=11218961