移动excel工作表时vba 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

这行得通。