Мы разрабатываем электронную таблицу, которая используется двумя отделами для передачи работы от yDepartment к xDepartment, после того как yDepartment завершил первую часть работы.
Мы настроили автоматическое электронное письмо дляполучать от yDepartment, содержащий данные, перемещаемые с одного листа на другой.Для этого информация копируется во временный рабочий лист, который удаляется после отправки электронного письма (это позволяет одновременно отправлять несколько и несмежных строк).
Это все работалохорошо, пока мы не поделились рабочей книгой, и запуск макроса привел к следующей ошибке:
Run time error ‘1004’:
Delete method of Worksheet class failed
Я скопировал наш код ниже (боюсь, это немного Франкенштейн)
Sub Pass_to_xDepartment()
Application.EnableEvents = False
On Error GoTo Whoops
'Declare variables
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim lastRow As Long
Dim lastRow2 As Long
Dim WSheet As Variant
Dim DTable As Variant
Dim Sendrng As Range
Dim sht3 As Worksheet
'MsgBox when passing over work
If MsgBox("Do you want to pass the selected work to xDepartment?" & vbNewLine & vbNewLine & "Please ensure selected work is complete." & vbNewLine & vbNewLine & "This will generate an automatic email to xDepartment.", vbYesNo, "Pass to xDepartment") = vbNo Then Exit Sub
For Each WSheet In ActiveWorkbook.Worksheets
If WSheet.AutoFilterMode Then
If WSheet.FilterMode Then
WSheet.ShowAllData
End If
End If
For Each DTable In WSheet.ListObjects
If DTable.ShowAutoFilter Then
DTable.Range.AutoFilter
DTable.Range.AutoFilter
End If
Next DTable
Next WSheet
'Set variables
Set sht1 = Sheets("yDepartment")
Set sht2 = Sheets("xDepartment")
'Move row to destination sheet & Delete source row
lastRow = sht2.Range("A" & sht2.Rows.Count).End(xlUp).Row
'Select Entire Row.Resize(ColumnSize:=12)
Intersect(Selection.EntireRow, Selection.Parent.Columns("N")).Value = Date
With Intersect(Selection.EntireRow, Selection.Parent.Range("A:N"))
.Copy Destination:=sht2.Range("A" & lastRow + 1)
lastRow2 = sht2.Range("A" & sht2.Rows.Count).End(xlUp).Row
.EntireRow.Delete
End With
Set sht3 = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
sht3.Name = "temp"
'Note: if the selection is one cell it will send the whole worksheet
Set Sendrng = sht2.Range("A" & (lastRow + 1) & ":N" & lastRow2)
Sendrng.Copy Destination:=sht3.Range("A1")
On Error GoTo StopMacro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Create the mail and send it
sht3.Activate
lastRow2 = sht3.Range("A" & sht3.Rows.Count).End(xlUp).Row
Set Sendrng = sht3.Range("A1:N" & lastRow2)
With Sendrng
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
' Set the optional introduction field thats adds
' some header text to the email body.
.Introduction = "Dear xDepartment," & vbNewLine & vbNewLine & "The following work has been completed." & vbNewLine & vbNewLine & "Please see the shared spreadsheet for further details." & vbNewLine & vbNewLine & "Kind regards," & vbNewLine & "yDepartment" & vbNewLine
With .Item
.To = "email"
.CC = "email"
.BCC = ""
.Subject = "New work passed over from yDepartment"
.Send
End With
End With
End With
StopMacro:
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("temp").Delete
Application.DisplayAlerts = True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False
Worksheets("yDepartment").Activate
MsgBox ("Tours have been passed to xDepartment.")
Whoops:
Application.EnableEvents = True
End Sub
Кто-нибудь знает, как избежать этой ошибки и разрешить нам удалить временный лист, пока рабочая книга является общей, или как отредактировать макрос, чтобы сделать его совместимым с рабочей книгой, которой вы делитесь?Есть ли другой способ получить электронное письмо для отправки, не создавая временный лист?Я думаю, что это был единственный способ, которым мы разработали, как иметь возможность выбирать несколько и несмежных строк для одновременной передачи.
Любая помощь очень ценится, спасибо.