Доброе утро! Я только-только начинаю изучать возможности VBA, и еще очень многого не понимаю. Поскольку в моей работе приходится пользоваться макросами, а ждать, пока кто-то решит все вопросы за меня, не хочется, пытаюсь постигать сию науку самостоятельно. Хотя получается пока слабо. Поэтому не судите строго, если вопрос глупый. У меня Excel 2010. Ежедневно мне приходится по электронке отправлять в качестве отчета один лист из книги, содержащей очень много других листов. Поскольку в 10 версии потерялась возможность отправки отдельного листа, приходится лист копировать в новую книгу (при этом нарушается форматирование, приходится исправлять вручную), и уже эту книгу отправлять. В интернете я нашла макрос, который, судя по описанию, должен такую проблему решить: [vba]
Код
Sub SendSheet() ThisWorkbook.Sheets("Лист1").Copy With ActiveWorkbook .SendMail Recipients:="name@yandex.ua", Subject:="итоговый отчет" .Close SaveChanges:=False End With End Sub
[/vba] Однако, если я запускаю макрос в таком виде, респондент получает пустую книгу с одним листом. Если я меняю название листа на мое, я получаю сообщение об ошибке. По моим рассуждениям вроде бы все должно работать. Когда я сама пытаюсь записать макрос, получается совсем другая версия, при выполнении которой все равно нужно вводить адрес респондента и т.д. Как исправить ошибку в прилагаемом макросе, чтобы все работало правильно? Заранее огромное спасибо
Доброе утро! Я только-только начинаю изучать возможности VBA, и еще очень многого не понимаю. Поскольку в моей работе приходится пользоваться макросами, а ждать, пока кто-то решит все вопросы за меня, не хочется, пытаюсь постигать сию науку самостоятельно. Хотя получается пока слабо. Поэтому не судите строго, если вопрос глупый. У меня Excel 2010. Ежедневно мне приходится по электронке отправлять в качестве отчета один лист из книги, содержащей очень много других листов. Поскольку в 10 версии потерялась возможность отправки отдельного листа, приходится лист копировать в новую книгу (при этом нарушается форматирование, приходится исправлять вручную), и уже эту книгу отправлять. В интернете я нашла макрос, который, судя по описанию, должен такую проблему решить: [vba]
Код
Sub SendSheet() ThisWorkbook.Sheets("Лист1").Copy With ActiveWorkbook .SendMail Recipients:="name@yandex.ua", Subject:="итоговый отчет" .Close SaveChanges:=False End With End Sub
[/vba] Однако, если я запускаю макрос в таком виде, респондент получает пустую книгу с одним листом. Если я меняю название листа на мое, я получаю сообщение об ошибке. По моим рассуждениям вроде бы все должно работать. Когда я сама пытаюсь записать макрос, получается совсем другая версия, при выполнении которой все равно нужно вводить адрес респондента и т.д. Как исправить ошибку в прилагаемом макросе, чтобы все работало правильно? Заранее огромное спасибоk987
Отправлять нужно только один лист? Какой лист нужо отправлять? Если на листе есть формулы, то нужно оставить только значения? Отправка всегда на один и тот же адрес?
[vba]
Код
Sub SendSheet() ' отправляет активный лист ActiveSheet.Copy With ActiveWorkbook .ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value ' удалить строку, если формулы нужны .SendMail Recipients:="адресс@gmail.com", Subject:="итоговый отчет. " & .ActiveSheet.Name ' & .ActiveSheet.Name можно удалить. .Close SaveChanges:=False End With End Sub
[/vba]
Отправлять нужно только один лист? Какой лист нужо отправлять? Если на листе есть формулы, то нужно оставить только значения? Отправка всегда на один и тот же адрес?
[vba]
Код
Sub SendSheet() ' отправляет активный лист ActiveSheet.Copy With ActiveWorkbook .ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value ' удалить строку, если формулы нужны .SendMail Recipients:="адресс@gmail.com", Subject:="итоговый отчет. " & .ActiveSheet.Name ' & .ActiveSheet.Name можно удалить. .Close SaveChanges:=False End With End Sub
Отправлять нужно всегда на один и тот же адрес, всегда один и тот же лист. На листе сводная таблица и еще несколько столбцов с формулами. Отправлять можно только значения, но в том же виде. какой и на исходном листе
Отправлять нужно всегда на один и тот же адрес, всегда один и тот же лист. На листе сводная таблица и еще несколько столбцов с формулами. Отправлять можно только значения, но в том же виде. какой и на исходном листеk987
[/vba] , где 33 - это порядковый номер листа, а Лист1 - это "кодовое имя" листа (посмотреть можно, нажав Альт F11 - вываливаемся в макросы; Контрл R - вываливаемся в окно VBAПроджект; там в скобочках мы видим обычное название листа (как в книге Excel), а перед скобками - другое (иногда совпадающее) - так вот оно-то нам и нужно.
Ольга, у Вас все нормально в коде, кроме, разве что, того, что так он имя произвольного листа не съест. А вот если Вы напишете [vba]
[/vba] , где 33 - это порядковый номер листа, а Лист1 - это "кодовое имя" листа (посмотреть можно, нажав Альт F11 - вываливаемся в макросы; Контрл R - вываливаемся в окно VBAПроджект; там в скобочках мы видим обычное название листа (как в книге Excel), а перед скобками - другое (иногда совпадающее) - так вот оно-то нам и нужно._Boroda_
Здравствуйте. Не подскажите, почему не срабатывает удаление формул? За ранее благодарю!
[vba]
Код
Option Explicit
Sub КаТЗ() Dim objOutlookApp As Object, objMail As Object Dim sTo As String, sSubject As String, sBody As String, sAttachment As String Dim objTmpMail As Object 'временное письмо для создания подписи 'Шаг 2: Скопируйте рабочую таблицу, вставьте ее в новую книгу и 'сохраните ее Sheets("Отправка КАТЗ").Copy ActiveWorkbook.SaveAs ThisWorkbook.Path & "\КаТЗ.xlsx"
Application.ScreenUpdating = False On Error Resume Next 'пробуем подключиться к Outlook, если он уже открыт Set objOutlookApp = GetObject(, "Outlook.Application") Err.Clear 'Outlook закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If objOutlookApp.Session.Logon Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
sTo = "" 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value) sSubject = "КаТЗ" 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value) sBody = "" 'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value) sAttachment = "" 'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
'создаем сообщение With objMail .ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value ' удалить строку, если формулы нужны .ReadReceiptRequested = True 'прочтение .OriginatorDeliveryReportRequested = True 'доставка .Importance = 2 'Варианты (0-normal, 1-low, 2-high) .To = sTo 'адрес получателя .CC = "" 'адрес для копии .BCC = "" 'адрес для скрытой копии .Subject = sSubject 'тема сообщения .Body = sBody 'текст сообщения .HTMLBody = sBody & .HTMLBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) .Attachments.Add (ThisWorkbook.Path & "\КаТЗ.xlsx") 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName 'добавляем подпись к письму 'создаем новое письмо Set objTmpMail = objOutlookApp.CreateItem(0) 'отображаем его - у него появится подпись objTmpMail.Display 'теперь к нашему текущему(рабочему) письму просто добавляем текст из временного objMail.Body = objMail.Body & objTmpMail.Body objTmpMail.Delete 'удаляем временное письмо
.Display 'Display/Send, если необходимо просмотреть сообщение, а не отправлять без просмотра End With ActiveWorkbook.Close SaveChanges:=True Kill ThisWorkbook.Path & "\КаТЗ.xlsx" Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub
[/vba]
Здравствуйте. Не подскажите, почему не срабатывает удаление формул? За ранее благодарю!
[vba]
Код
Option Explicit
Sub КаТЗ() Dim objOutlookApp As Object, objMail As Object Dim sTo As String, sSubject As String, sBody As String, sAttachment As String Dim objTmpMail As Object 'временное письмо для создания подписи 'Шаг 2: Скопируйте рабочую таблицу, вставьте ее в новую книгу и 'сохраните ее Sheets("Отправка КАТЗ").Copy ActiveWorkbook.SaveAs ThisWorkbook.Path & "\КаТЗ.xlsx"
Application.ScreenUpdating = False On Error Resume Next 'пробуем подключиться к Outlook, если он уже открыт Set objOutlookApp = GetObject(, "Outlook.Application") Err.Clear 'Outlook закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If objOutlookApp.Session.Logon Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
sTo = "" 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value) sSubject = "КаТЗ" 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value) sBody = "" 'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value) sAttachment = "" 'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
'создаем сообщение With objMail .ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value ' удалить строку, если формулы нужны .ReadReceiptRequested = True 'прочтение .OriginatorDeliveryReportRequested = True 'доставка .Importance = 2 'Варианты (0-normal, 1-low, 2-high) .To = sTo 'адрес получателя .CC = "" 'адрес для копии .BCC = "" 'адрес для скрытой копии .Subject = sSubject 'тема сообщения .Body = sBody 'текст сообщения .HTMLBody = sBody & .HTMLBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) .Attachments.Add (ThisWorkbook.Path & "\КаТЗ.xlsx") 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName 'добавляем подпись к письму 'создаем новое письмо Set objTmpMail = objOutlookApp.CreateItem(0) 'отображаем его - у него появится подпись objTmpMail.Display 'теперь к нашему текущему(рабочему) письму просто добавляем текст из временного objMail.Body = objMail.Body & objTmpMail.Body objTmpMail.Delete 'удаляем временное письмо
.Display 'Display/Send, если необходимо просмотреть сообщение, а не отправлять без просмотра End With ActiveWorkbook.Close SaveChanges:=True Kill ThisWorkbook.Path & "\КаТЗ.xlsx" Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub