[發問] 程式F8可以F5就當機，以及關閉WORD.EXE

iceandy6150

大家好，我寫了一個按鈕，按下去之後，主要功能是開啟一個WORD檔
然後進行合併列印，並合併列印到新檔案
等使用者列印後，關掉新檔案跟原檔案
(這邊本來想要寫成，新檔案會自動列印，然後關掉所有WORD檔)
(但是怕使用者的印表機可能不盡相同，因此作罷)

前面會先檢查是否已經開啟WORD檔
有開就詢問是否關掉WORD，或者不存檔強制關閉

問題在，每一次使用者列印後，關掉WORD新檔案跟原檔案後
其實【工作管理員】裡面，WORD.EXE這個程序還是存在

然後【先檢查是否已經開啟WORD檔】這邊，如果F8逐步執行，是沒問題的
如果直接按下按鈕執行，就會卡住(F5直接執行就會卡住)
解決辦法是去【工作管理員】裡面，把WORD.EXE這個程序關掉，才能正常跑

1. Private Sub CommandButton2_Click()
   
2. '====偵測是否有開啟中的WORD檔，並選則是否存檔關閉====
   
3. 
   
4. Dim WordApp As Object, Doc As Object
   
5. Dim box
   
6. On Error GoTo Skip  '設置出錯跳轉位置
   
7. Set WordApp = GetObject(, "word.application")  '獲取第一個word進程
   
8. Do While Not WordApp Is Nothing  '如果成功獲取進程,則進入迴圈操作
   
9.     With WordApp
   
10.         If .Documents.Count > 0 Then  '如果進程中有打開的文檔
    
11. 
    
12.             MsgBox ("偵測到有尚未關閉的WORD檔案")
    
13.             box = MsgBox("您要離開本程式，先將WORD檔案關閉?" + Chr(13) + "【是】離開本程式" + Chr(13) + "【否】不存檔直接關閉WORD", 4, "重要訊息")
    
14. 
    
15.             If box = 6 Then
    
16.                Exit Sub
    
17. 
    
18.             Else
    
19. 
    
20.             For Each Doc In .Documents  '迴圈各個打開的文檔
    
21.                 Doc.Close False  '關閉文檔並不保存(注:想保存的話,將後面的參數改為True)
    
22.             Next Doc
    
23. 
    
24.             End If
    
25. 
    
26.         End If
    
27.         .Quit  '關閉當前的word進程 <<<<<<這邊如果F8執行，是可以成功關閉工作管理員中的WORD.EXE的
    
28.     End With
    
29.     Set WordApp = GetObject(, "word.application")  '獲取下一個word進程
    
30. Loop
    
31. Skip:
    
32.     Set Doc = Nothing  '結束或出錯跳轉至此,清空變數專案
    
33.     Set WordApp = Nothing
    
34. '================================
    
35. 
    
36. Dim wdObj As Object
    
37. Dim strXls As String,  strSQL As String
    
38. Dim a, b
    
39. 
    
40. 
    
41. a = ThisWorkbook.Path  '此EXCEL檔案存放位置
    
42. b = ThisWorkbook.Name  'b為檔名
    
43. strXls = a & "\" & b   '此EXCEL檔案完整路徑及檔名
    
44. 
    
45. 
    
46. Set wdObj = CreateObject("Word.Application") '會先把所有WORD都關掉，所以用Creat 不用Get
    
47. Set wdObj = New Word.Application '啟動Word
    
48. wdObj.Visible = True
    
49. wdObj.Documents.Open (a & "\列印.docx")
    
50. 
    
51. 
    
52. With wdObj   '使用With後就正常了
    
53. 
    
54.      '這邊以下是用WORD錄製巨集得到的合併列印寫法
    
55.     .ActiveDocument.MailMerge.OpenDataSource Name:= _
    
56.         strXls, ConfirmConversions:=False, _
    
57.         ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
    
58.         PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
    
59.         WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
    
60.         Connection:= _
    
61.         "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=strXls;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locki" _
    
62.         , SQLStatement:="SELECT * FROM `工作表1", SQLStatement1:="", SubType:= _
    
63.         wdMergeSubTypeAccess
    
64.         
    
65.     .ActiveDocument.MailMerge.Fields.Add Range:=.ActiveDocument.Tables(1).Cell(2, 1).Range, Name:="號碼"
    
66.    
    
67.     .CommandBars("Mail Merge Panes").Visible = False
    
68.    
    
69.     With .ActiveDocument.MailMerge
    
70.         .Destination = wdSendToNewDocument
    
71.         .SuppressBlankLines = True
    
72.         With .DataSource
    
73.             .FirstRecord = wdDefaultFirstRecord
    
74.             .LastRecord = wdDefaultLastRecord
    
75.         End With
    
76.         .Execute Pause:=False
    
77.     End With
    
78.    
    
79. End With
    
80. 
    
81. Set wdObj = Nothing
    
82. 
    
83. MsgBox ("列印後，關閉WORD檔案時，記得通通【不要儲存】")
    
84. MsgBox ("最後不印了，記得執行【清除背景WORD程式】")
    
85. 
    
86. End Sub

複製代碼

求救各位，謝謝
合併列印測試.rar (34.5 KB)

下載次數: 6

2020-3-31 23:10