移动Excel工作表时,vba excel保持打开状态

时间:2017-05-27 18:55:18

标签: excel vba

我有这个代码。我基本上在一张纸上生成一个列表并将其重命名为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

2 个答案:

答案 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

这很有用。