Question

我运行此代码并且excel会话不会被破坏或关闭。我知道我没有使用sheets.add或ws.delete，因为它说使用验证，我不知道如何使用单行声明我的对象。我不知道我猜的语法。这是代码。有人可以指出如何解决它吗？

Public Function ComboLists()
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim MyFileName As String
Dim bfile As String
Dim MyList(1) As String
Dim lRow As Long

bfile = "S:\_Reports\KSMS\Designated Letter\KSMS Designated Letter - "

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

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
xlApp.DisplayAlerts = False

MyList(0) = "Approve Location"
MyList(1) = "Delete Location"

lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

i = 2

For Each c In wb.Sheets(1).Range("M" & lRow)

If ws.Cells(i, 12).Value = "US" Then
rng = "M" & i '& ":" & "Z" & i

With Range(rng).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
     Operator:=xlBetween, Formula1:=Join(MyList, ",")
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
End With
Else
rng = "A" & i & ":" & "L" & i
With xlApp.Range(rng).Validation
ws.Delete
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
'wb.Close savechanges:=False
End With
End If


i = i + 1

Next c

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

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

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

xlApp.Quit
xlApp.Quit
xlApp.Quit
xlApp.Quit

Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing

Exit Function

End Function

我将不胜感激。

Answer 1

更改

lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

到

lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

或者在代码完成后，您仍然会引用Excel应用程序。

使用不合格的Rows，您的应用程序（Word？Access？PowerPoint？）需要创建一个虚拟ActiveSheet对象以供该方法使用。在销毁虚拟对象之前，需要维护Excel实例。在退出应用程序之前，该对象不会被销毁，因此Excel实例将一直存在，直到您退出应用程序。

我最初没有发现它，但你也有一个不合格的Range

With Range(rng).Validation

需要

With ws.Range(rng).Validation

使用多个Application对象的黄金法则是始终完全限定所有内容。

Answer 2

Public Function ComboLists()
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim MyFileName As String
Dim bfile As String
Dim MyList(1) As String
Dim lRow As Long

bfile = "S:\_Reports\KSMS\Designated Letter\KSMS Designated Letter - "

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

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
xlApp.DisplayAlerts = False

MyList(0) = "Approve Location"
MyList(1) = "Delete Location"

lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

MsgBox lRow

i = 2

'For Each c In wb.Sheets(1).Range("M2:M1000") '" & Range("V" & Rows.count).End(xlUp).Row)
For Each c In wb.Sheets(1).Range("M" & lRow)

If ws.Cells(i, 12).Value = "US" Then
rng = "M" & i '& ":" & "Z" & i

With xlApp.Range(rng).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
     Operator:=xlBetween, Formula1:=Join(MyList, ",")
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
DoEvents
End With
Else
rng = "A" & i & ":" & "L" & i
With xlApp.Range(rng).Validation
ws.Delete
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
DoEvents
End With
DoEvents
End If

i = i + 1

Next c

DoEvents

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

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

wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
wb.Close savechanges:=False
DoEvents
MsgBox "quit"
xlApp.Quit

Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing

Exit Function

End Function

我添加了lrow lRow = ws.Cells（ws.Rows.Count，1）.End（xlUp）。我添加了ws。在行前面的单元格和ws前面，这有助于破坏会话

程序运行后，excel不会关闭

2 个答案: