Моя компания в настоящее время обновляется до 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
'' ''