我有这个代码。我基本上在一张纸上生成一个列表并将其重命名为RSSR List。然后我拿起那张纸并把它移到现有的纸张上。最后一行代码不会保存我执行所有格式化的工作簿,并且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
答案 0 :(得分:0)
有时候这些问题可以通过在违规操作后发出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来说是必要的。
答案 1 :(得分:0)
ws.Move Before:=xlApp.Workbooks("Tyco-Brooks Receiving Tracking Master V 1.4...)Sheets(1)
DoEvents
这很有用。