Access中的VBA : Sheet.Delete方法在For循环中不工作

Question

我是一名生命科学家，第一次尝试编码，并试图为我的测量数据建立一个Access数据库。所以我很缺乏经验。

我已将Excel对象嵌入到要用于计算的访问表单中。如果不首先删除对象的旧数据，我就不能使用对象，我使用的是.Next循环(代码见下文)。它有时有效，通常是第一次尝试，有时是前三次尝试。我需要它持续工作。

我试过隔离这个问题，但问题归结为wbAnalysis.Sheets.(iSheetCounter).Delete行。什么都不做？我发现的修复(激活工作簿、创建Excel对象和禁用错误，而不是通过Excel.Application)似乎没有做任何事情。

代码不会抛出任何类型的错误，它运行良好，只是不删除工作表。

任何帮助都将不胜感激！

提前谢谢你！

Private Sub Form_Load()
    Dim wbAnalysis As Excel.Workbook
    Dim iSheetCounter As Integer
    Dim appExcel As Object

    Set wbAnalysis = Me!OLEExcel.Object
    Set appExcel = CreateObject("Excel.Application")

        For iSheetCounter = 1 To wbAnalysis.Worksheets.Count
            If wbAnalysis.Sheets.Count > 1 Then
                appExcel.DisplayAlerts = False
                wbAnalysis.Sheets(iSheetCounter).Activate
                wbAnalysis.Sheets(iSheetCounter).UsedRange.Delete
                wbAnalysis.Sheets(iSheetCounter).Delete
                appExcel.DisplayAlerts = True
            End If
        Next iSheetCounter

End Sub

我在注释之后编辑了代码，使其看起来像这样。不幸的是，它仍然只工作了大约一半的时间，另一半抛出一个窗口错误声音，没有任何消息箱。

Private Sub btnDelete_Click()

    Dim wbAnalysis As Excel.Workbook
    Dim iSheetCounter As Integer
    Dim appExcel As Object

    Set wbAnalysis = Me!OLEExcel.Object
    Set appExcel = CreateObject("Excel.Application")

        For iSheetCounter = 1 To wbAnalysis.Worksheets.Count
            If wbAnalysis.Worksheets.Count > 1 Then
                'appExcel.DisplayAlerts = False
                wbAnalysis.Sheets(iSheetCounter).Delete
                'appExcel.DisplayAlerts = True
            End If
        Next iSheetCounter

End Sub

这是一个Excel实例问题。对于打开OLE对象的Excel实例，'appExcel.DisplayAlerts = False`‘行不关闭DisplayAlerts。解决方案如下：

 Dim wbAnalysis As Excel.Workbook
    Dim iSheetCounter As Integer
    Dim appExcel As Object
    Dim nSheets As Long


    Set wbAnalysis = Me!OLEExcel.Object
    Set appExcel = CreateObject("Excel.Application")
    appExcel.DisplayAlerts = False
    Excel.Application.DisplayAlerts = False

    nSheets = wbAnalysis.Worksheets.Count

        For iSheetCounter = nSheets To 2 Step -1
            If wbAnalysis.Worksheets.Count > 1 Then
                wbAnalysis.Application.DisplayAlerts = False
                wbAnalysis.Worksheets(iSheetCounter).Delete
                wbAnalysis.Application.DisplayAlerts = True
            End If
        Next iSheetCounter

Answer 1

我相信这是由于这行wbAnalysis.Sheets(iSheetCounter).Delete最初它删除的工作表很好，但是每次删除一个工作表时，Worksheets对象的长度就会减少。因此，在某个点之后，当可用工作表的总数小于iSheetCounter时，它将不会得到相应的表。试试下面的代码。这将继续删除第一个可用的工作表，直到只剩下一个工作表。

Private Sub btnDelete_Click()

    Dim wbAnalysis As Excel.Workbook
    Dim iSheetCounter As Integer
    Dim appExcel As Object

    Set wbAnalysis = Me!OLEExcel.Object
    Set appExcel = CreateObject("Excel.Application")

        For iSheetCounter = 1 To wbAnalysis.Worksheets.Count
            If wbAnalysis.Worksheets.Count > 1 Then
                'appExcel.DisplayAlerts = False
                wbAnalysis.Worksheets(1).Delete
                'appExcel.DisplayAlerts = True
            End If
        Next iSheetCounter

End Sub

Answer 2

在循环中按索引号从集合中删除对象时，最好从最后一个删除到第一个。

如下所示：

' to avoid problems if .Count changes during the loop, save it in a variable
nSheets = wbAnalysis.Worksheets.Count
' countdown loop from last to second sheet
For iSheetCounter = nSheets To 2 Step -1
    wbAnalysis.Worksheets(iSheetCounter ).Delete
Next iSheetCounter

Answer 3

作为一般原则，在迭代集合时添加或删除集合中的项从来都不是一个好主意。使用这样的代码要好得多。

Private Sub btnDelete_Click()

    Dim wbAnalysis As Excel.Workbook
    Dim iSheetCounter As Integer
    Dim appExcel As Object
    Dim ws As Worksheet
    Dim toDelete As New Collection

    Set wbAnalysis = Me!OLEExcel.Object
    Set appExcel = CreateObject("Excel.Application")

    ' decide which items to delete
    For iSheetCounter = 1 To wbAnalysis.Worksheets.Count
        If wbAnalysis.Worksheets.Count > 1 Then
            toDelete.Add wbAnalysis.Sheets(iSheetCounter)
        End If
    Next iSheetCounter
    
    ' delete items
    for each ws in toDelete
        ws.delete
    next ws

End Sub