Excel 2016 VBA Проблема Ошибка выполнения 91 - Удалить лист - PullRequest
0 голосов
/ 11 января 2020

Моя компания в настоящее время обновляется до Office 365 и Excel (64-разрядная версия) с Office 2013 (32-разрядная версия). Мне "дали возможность" решить некоторые проблемы VBA.

У меня мало опыта, и я потратил пару часов, пытаясь решить проблему, описанную ниже. Я уверен, что это простое исправление для тех, у кого больше знаний, чем у меня. Я знаю, что переход с 32-разрядной версии Excel 2016 на 64-разрядную версию Excel 2016 теперь использует VBA 7.

Существует некоторый VBA, который создает временный лист, и когда он пытается удалить его, он выдает «Ошибка времени выполнения 91. Ошибка переменной объекта или переменная блока не установлена».

очистка:

Application.DisplayAlerts = False
Cws.Delete  'this is line that fails
Application.DisplayAlerts = True
'Remove formula
Range("V3", Cells(Fill_Row, 34)).ClearContents

проблема с кодом

Есть идеи, что мне нужно изменить?

Полный код ниже:

'' 'Sub SubFileFile ()

Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim Ash As Worksheet
Dim Cws As Worksheet
Dim Rcount As Long
Dim Rnum As Long
Dim FilterRange As Range
Dim FieldNum As Integer
Dim mailAddress As String
Dim ccAddress As String
Dim NewWB As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Fill_Row   As Long
    Dim strDir As String

strDir = Worksheets("Variables").Range("B26")
'Find last row of pivot
Fill_Row = Range("A2")
        ccAddress = Range("B3")
If Range("B2") <> "" Then
If MsgBox(Range("B2") & "  Send anyway?", vbYesNo) = vbNo Then Exit Sub
End If

On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

'Autofill Formula
Range("V2:AH2").AutoFill Destination:=Range("V2", Cells(Fill_Row, 34)), Type:=xlFillDefault

'Set filter sheet, you can also use Sheets("MySheet")
Set Ash = ActiveSheet

'Set filter range and filter column (column with names)
Set FilterRange = Ash.Range("F1:U" & Ash.Rows.Count)
FieldNum = 1    'Filter column = A because the filter range start in column A

'Add a worksheet for the unique list and copy the unique list in A1
Set Cws = Worksheets.Add
FilterRange.Columns(FieldNum).AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=Cws.Range("A1"), _
        CriteriaRange:="", Unique:=True

'Count of the unique values + the header cell
Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))

'If there are unique values start the loop
If Rcount >= 2 Then
    For Rnum = 2 To Rcount

        'Look for the mail address in the MailInfo worksheet
        mailAddress = ""
        On Error Resume Next
        mailAddress = Application.WorksheetFunction. _
            VLookup(Cws.Cells(Rnum, 1).Value, _
                      Worksheets("Commission").Range("A5:B" & _
                            Worksheets("Commission").Rows.Count), 2, False)
        On Error GoTo 0

        If mailAddress <> "" Then

            'Filter the FilterRange on the FieldNum column
            FilterRange.AutoFilter Field:=FieldNum, _
                                   Criteria1:=Cws.Cells(Rnum, 1).Value

            'Copy the visible data in a new workbook
            With Ash.AutoFilter.Range
                On Error Resume Next
                Set rng = .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
            End With

            Set NewWB = Workbooks.Add(xlWBATWorksheet)

            rng.Copy
            With NewWB.Sheets(1)
                .Cells(1).PasteSpecial Paste:=8
                .Cells(1).PasteSpecial Paste:=xlPasteValues
                .Cells(1).PasteSpecial Paste:=xlPasteFormats
                .Cells(1).Select
                Application.CutCopyMode = False
            End With

            'Create a file name
            TempFilePath = strDir & "\"
            TempFileName = "Sales Installed Report for " & Replace(Range("A2"), "/", "-") _
                         & " " & Range("P1")

            If Val(Application.Version) < 12 Then
                'You use Excel 97-2003
                FileExtStr = ".xls": FileFormatNum = -4143
            Else
                'You use Excel 2007-2016
                FileExtStr = ".xlsx": FileFormatNum = 51
            End If

            'Save, Mail, Close and Delete the file

            With NewWB
                .SaveAs TempFilePath & TempFileName _
                      & FileExtStr, FileFormat:=FileFormatNum
                On Error Resume Next

                On Error GoTo 0
                .Close savechanges:=False
            End With

        End If

        'Close AutoFilter
        Ash.AutoFilterMode = False

    Next Rnum
End If



cleanup:
Application.DisplayAlerts = False
Cws.Delete
Application.DisplayAlerts = True
'Remove formula
Range("V3", Cells(Fill_Row, 34)).ClearContents

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

''Send email if agent has no sales
'Call No_Sale_Email


''Display pop up window
MsgBox "Report Complete."

End Sub

'' ''

Ответы [ 2 ]

0 голосов
/ 11 января 2020

Ошибка перед тем, как вы установите cws при добавлении нового листа. Ваша ошибка не при удалении листа. Ваша ошибка возникает из-за того, что у вас есть:

On Error GoTo cleanup

, что приводит вас к:

cleanup:
Cws.Delete

До:

 Set Cws = Worksheets.Add

Избавьтесь от "При ошибке ... ", проверьте эту ошибку и, при необходимости, создайте новую запись.

0 голосов
/ 11 января 2020

Я думаю, это может быть потому, что вы еще не присвоили значение переменной

(например, установите cws = Thisworkbook.sheets ("sheetname")). Пожалуйста, проверьте переменную cws еще раз

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...