vba excel在移動Excel表格時保持打開狀態

Question

我有這段代碼。我基本上是在一張紙上生成一個列表並將其重命名爲RSSR列表。然後我拿起那張紙並將它移到一張現有的紙上。會發生什麼情況是代碼的最後幾行不會保存工作簿，我會將所有格式化並且excel不會關閉。我將表格移到了保存的工作簿以及該excel的實例已關閉。當我在excel上結束任務並重新運行代碼時，它說實例不再存在類似於服務器或機器的東西不再存在。我無法得到我移動的excel表來保存並關閉excel的實例。如果它殺死excel它會在下次運行該過程時出錯。我想在此過程中關閉excel。這裏是我的代碼：

Public Function BrooksFormatBrooks() 
Dim xlApp As Excel.Application 
Dim xlApp2 As Excel.Application 
Dim wb As Excel.Workbook 
Dim ws As Excel.Worksheet 
Dim wb2 As Excel.Workbook 
Dim ws2 As Excel.Worksheet 
Dim MyFileName As String 
Dim afile As String 
Dim bfile As String 

afile = "S:\Brooks\Tyco-Brooks Receiving Tracking MASTER V 1.4 2017-05-06.xlsx" 
bfile = "S:\_Reports\Brooks\Tyco-Brooks Receiving Tracking MASTER - " 

MyFileName = bfile & Format(Date, "mm-dd-yyyy") & ".xls" 
MyFileName2 = afile 

On Error Resume Next 
Set xlApp = CreateObject("Excel.Application") 
On Error GoTo 0 

Set wb2 = xlApp2.Workbooks.Open(MyFileName2) 
Set ws2 = wb2.Sheets(1) 
ws2.Activate 

xlApp.DisplayAlerts = False 
wb2.Sheets("RSSR_List").Delete 
xlApp.DisplayAlerts = True 

wb2.CheckCompatibility = False 
wb2.Save 
wb2.CheckCompatibility = True 
wb2.Close SaveChanges:=False 

xlApp.Quit 

Set xlApp = Nothing 
Set wb2 = Nothing 
Set ws2 = Nothing 

On Error Resume Next 
Set xlApp = CreateObject("Excel.Application") 
On Error GoTo 0 

Set wb = xlApp.Workbooks.Open(MyFileName) 
Set ws = wb.Sheets(1) 
ws.Activate 

wb.Sheets(1).Name = "RSSR_List" 

Set ws = wb.Sheets(1) 
ws.Activate 

wb.ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$F$312"), , xlYes).Name = _ 
    "RSSR" 

ws.Range("A1:F312").Select 

ws.Cells.Rows("2:2").Select 
xlApp.ActiveWindow.FreezePanes = False 
xlApp.ActiveWindow.FreezePanes = True 

ws.Columns("A:Z").HorizontalAlignment = xlCenter 
ws.Rows("1:1").Font.Bold = True 
ws.Rows("1:1").Font.ColorIndex = 1 
ws.Rows("1:1").Interior.ColorIndex = 15 
ws.Cells.Font.Name = "Calbri" 
ws.Cells.Font.Size = 8 
ws.Cells.EntireColumn.AutoFit 
ws.Cells.EntireRow.AutoFit 

xlApp.Cells.Borders.LineStyle = xlContinuous 
xlApp.Cells.Borders.Weight = xlThin 
xlApp.Cells.Borders.ColorIndex = 0 

ws.Cells.Rows("1:1").Select 

wb.CheckCompatibility = False 
wb.Save 
wb.CheckCompatibility = True 
wb.Close SaveChanges:=False 

Set wb2 = xlApp.Workbooks.Open(MyFileName2) 

MsgBox "Before Move" 
ws.Move Before:=Workbooks("Tyco-Brooks Receiving Tracking MASTER V 1.4 2017-05-06.xlsx").Sheets(1) 
MsgBox "AFter Move" 

wb2.CheckCompatibility = False 
wb2.Save 
wb2.CheckCompatibility = True 
wb2.Close SaveChanges:=True 

Set wb = xlApp.Workbooks.Open(MyFileName) 

wb.CheckCompatibility = False 
wb.Save 
wb.CheckCompatibility = True 
wb.Close SaveChanges:=True 

xlApp.Quit 

Set xlApp = Nothing 
Set wb = Nothing 
Set ws = Nothing 
Set wb2 = Nothing 
Set ws2 = Nothing 


End Function 

Answer 1

有時這些各種各樣的問題，可以通過將一個DoEvents呼叫違規操作後得到解決。因此，在這種情況下，你有這樣的：

MsgBox "Before Move" 
ws.Move Before:=Workbooks("Tyco-Brooks Receiving Tracking MASTER V 1.4 2017-05-06.xlsx").Sheets(1) 
DoEvents 
MsgBox "AFter Move" 

這往往爲Excel 2016年

Answer 2

ws.Move Before:=xlApp.Workbooks("Tyco-Brooks Receiving Tracking Master V 1.4...)Sheets(1) 
DoEvents 

這個工作是必要的。