Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Вывести таблицу в PDF и отправить ее через outlook - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 212»
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вывести таблицу в PDF и отправить ее через outlook (Макросы/Sub)
Вывести таблицу в PDF и отправить ее через outlook
lebensvoll Дата: Четверг, 08.09.2016, 17:54 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
Добрый вечер много уважаемые форумчане....
Прошу вас вновь о помощи :'( %) :(
Имеется код (который позволяет сохранить данные с таблицы в общий журнал на другой лист. При этом очищается таблица для внесения новых данных):
[vba]
Код

Private Sub CommandButton5_Click() 'Код для сохранения данных на лист Журнал реестра на отгрузку
q = MsgBox("Вы уверены что хотите сохранить данные в ЖУРНАЛ РЕЕСТРА НА ОТГРУЗКУ???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
    ' Dim lStartSheet_("Реестр на отгрузку") As Long, lEndSheet_("Реестр на отгрузку") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Реестр на отгрузку")" и "shSheet_("журнал реестра на отгрузку")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Реестр на отгрузку")
    Set shSheett = Worksheets("журнал реестра на отгрузку")
    lStartSheet = 11
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
    For i = lStartSheet To lEndSheet
    If Not shSheetf.Cells(i, 1).Value = Empty Then
    'Перносим данные на второй лист.
    shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
    For X = 2 To 12
    shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
    Next X
    'Изменяем переменную "lLastRow",
    'чтобы данные уже вставлять в следующую строку.
    lLastRow = lLastRow + 1
    End If
    Next i
    Range(Cells(11, 1), Cells(lEndSheet, 70)).ClearContents
    MsgBox "Данные перенесены на Лист Журнал реестра на отгрузку..."
End Sub
[/vba]
Хотелось бы чтоб перед тем как он скопирует данные и перенесет их сформировал PDF файл данной таблицы (без его сохранения куда либо этот PDF "лишь для отправки на почту") и направил данный файл на электронный адрес (к примеру:a.anisimov@gradindustry.ru) проинформировал об этих действиях в виде предупреждения (чтоб оператор понимал что произошло и соглашался с действиями. И лишь потом уже сработал код который был указан выше.
Наткнулся на тему КРОСС: My WebPage
Цитата
Способ 3. Универсальный макрос

пытался применить его к своей теме :'( не удачно (((( потерялся в кодах.
А также опасаюсь того что скорее всего не возможно будет в виду того что данные то скорее всего потеряются после того как переведешь в PDF и отправишь на почту ((((
Помогите, пожалуйста или же объясните


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеДобрый вечер много уважаемые форумчане....
Прошу вас вновь о помощи :'( %) :(
Имеется код (который позволяет сохранить данные с таблицы в общий журнал на другой лист. При этом очищается таблица для внесения новых данных):
[vba]
Код

Private Sub CommandButton5_Click() 'Код для сохранения данных на лист Журнал реестра на отгрузку
q = MsgBox("Вы уверены что хотите сохранить данные в ЖУРНАЛ РЕЕСТРА НА ОТГРУЗКУ???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
    ' Dim lStartSheet_("Реестр на отгрузку") As Long, lEndSheet_("Реестр на отгрузку") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Реестр на отгрузку")" и "shSheet_("журнал реестра на отгрузку")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Реестр на отгрузку")
    Set shSheett = Worksheets("журнал реестра на отгрузку")
    lStartSheet = 11
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
    For i = lStartSheet To lEndSheet
    If Not shSheetf.Cells(i, 1).Value = Empty Then
    'Перносим данные на второй лист.
    shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
    For X = 2 To 12
    shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
    Next X
    'Изменяем переменную "lLastRow",
    'чтобы данные уже вставлять в следующую строку.
    lLastRow = lLastRow + 1
    End If
    Next i
    Range(Cells(11, 1), Cells(lEndSheet, 70)).ClearContents
    MsgBox "Данные перенесены на Лист Журнал реестра на отгрузку..."
End Sub
[/vba]
Хотелось бы чтоб перед тем как он скопирует данные и перенесет их сформировал PDF файл данной таблицы (без его сохранения куда либо этот PDF "лишь для отправки на почту") и направил данный файл на электронный адрес (к примеру:a.anisimov@gradindustry.ru) проинформировал об этих действиях в виде предупреждения (чтоб оператор понимал что произошло и соглашался с действиями. И лишь потом уже сработал код который был указан выше.
Наткнулся на тему КРОСС: My WebPage
Цитата
Способ 3. Универсальный макрос

пытался применить его к своей теме :'( не удачно (((( потерялся в кодах.
А также опасаюсь того что скорее всего не возможно будет в виду того что данные то скорее всего потеряются после того как переведешь в PDF и отправишь на почту ((((
Помогите, пожалуйста или же объясните

Автор - lebensvoll
Дата добавления - 08.09.2016 в 17:54
lebensvoll Дата: Четверг, 08.09.2016, 18:12 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
Сам лист с таблицей (где задана область печати - именно ее и нужно перевести в PDF)
К сообщению приложен файл: 0354979.xlsm(38Kb)


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеСам лист с таблицей (где задана область печати - именно ее и нужно перевести в PDF)

Автор - lebensvoll
Дата добавления - 08.09.2016 в 18:12
devilkurs Дата: Четверг, 08.09.2016, 18:31 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 43 ±
Замечаний: 0% ±

Excel 2007, 2010
На вскидку...

чтобы сохранить в ПДФ диапазон области печати:

[vba]
Код
    Range(ActiveSheet.PageSetup.PrintArea).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Книга1.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
[/vba]
Где ActiveSheet.PageSetup.PrintArea - заданная область печати
"C:\Книга1.pdf" - полный адрес и имя сохраняемого файла пдф

Далее отправляйте данный сохраненный файл почтой, после его удалите

С соседнего форума код на отправку (не знаю можно ли указать сайт)


 
Ответить
СообщениеНа вскидку...

чтобы сохранить в ПДФ диапазон области печати:

[vba]
Код
    Range(ActiveSheet.PageSetup.PrintArea).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Книга1.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
[/vba]
Где ActiveSheet.PageSetup.PrintArea - заданная область печати
"C:\Книга1.pdf" - полный адрес и имя сохраняемого файла пдф

Далее отправляйте данный сохраненный файл почтой, после его удалите

С соседнего форума код на отправку (не знаю можно ли указать сайт)

Автор - devilkurs
Дата добавления - 08.09.2016 в 18:31
lebensvoll Дата: Четверг, 08.09.2016, 19:41 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010


Кто бы ты ни был, мир в твоих руках

Сообщение отредактировал lebensvoll - Четверг, 08.09.2016, 20:04
 
Ответить
Сообщение

Автор - lebensvoll
Дата добавления - 08.09.2016 в 19:41
lebensvoll Дата: Четверг, 08.09.2016, 19:45 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
devilkurs, прошу меня простить, я сделал как вы мне сказали. Но в виду того что не могу проверить его работу так как дома уже (((( проверю завтра:
сам код в предыдущем сообщении
1. Действия сохранения сработали и предупреждает (чтоб оператор мог решать согласен он на эти действия или же нет... :hands:
2. Дальше предупреждения также сработали перед отправкой и началась загрузка
Цитата
аутлука
hands а вот дальнейшие действия проверить не смог :'(
Возник сразу же вопрос а вдруг случится так что у нас слител сервак :o (такое бывает) и пользоваться почтой нет возможности.
Цитата
Тогда оператор не сможет сохранить данные на другой лист в общий журнал реестра (так как не смог отправить почту).

По сути он его уже сохранил и если что сможет отправить его позже. Но данные то он должен будет сохранить в общий журнал, чтоб смог (не переживая) продолжить свою работу на других листах???
СПАСИБКИ ВАМ ОГРОМНЕЙШЕЕ


Кто бы ты ни был, мир в твоих руках

Сообщение отредактировал lebensvoll - Четверг, 08.09.2016, 19:45
 
Ответить
Сообщениеdevilkurs, прошу меня простить, я сделал как вы мне сказали. Но в виду того что не могу проверить его работу так как дома уже (((( проверю завтра:
сам код в предыдущем сообщении
1. Действия сохранения сработали и предупреждает (чтоб оператор мог решать согласен он на эти действия или же нет... :hands:
2. Дальше предупреждения также сработали перед отправкой и началась загрузка
Цитата
аутлука
hands а вот дальнейшие действия проверить не смог :'(
Возник сразу же вопрос а вдруг случится так что у нас слител сервак :o (такое бывает) и пользоваться почтой нет возможности.
Цитата
Тогда оператор не сможет сохранить данные на другой лист в общий журнал реестра (так как не смог отправить почту).

По сути он его уже сохранил и если что сможет отправить его позже. Но данные то он должен будет сохранить в общий журнал, чтоб смог (не переживая) продолжить свою работу на других листах???
СПАСИБКИ ВАМ ОГРОМНЕЙШЕЕ

Автор - lebensvoll
Дата добавления - 08.09.2016 в 19:45
lebensvoll Дата: Пятница, 09.09.2016, 11:35 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
devilkurs, СПАСИБО ОГРОМНЕЙШЕЕ все сработало на УРА :hands:
Только прошу вас помочь, можно ли дополнить код еще одним действием???
Как удалить сохраненный файл после отправки???
[vba]
Код

Private Sub CommandButton5_Click() 'Код для сохранения данных на лист Журнал реестра на отгрузку

q = MsgBox("Вы уверены что хотите сохранить в PDF???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код сохранения
Range(ActiveSheet.PageSetup.PrintArea).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\a.anisimov\Desktop\Диспечерезация(2).pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

q = MsgBox("Вы уверены что хотите отправить сохраненный файл по почте???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код для отправки данного файла на почту Outlook
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
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 = "a.anisimov@gradindustry.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
sSubject = "Реестр на отгрузку"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
sBody = "Здравствуйте направляю вам реестр на отгрузку"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
sAttachment = "C:\Users\a.anisimov\Desktop\Диспечерезация(2).pdf"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
'создаем сообщение
With objMail
.To = sTo 'адрес получателя
.CC = "" 'адрес для копии
.BCC = "" 'адрес для скрытой копии
.Subject = sSubject 'тема сообщения
.Body = sBody 'текст сообщения
'.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
.Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
.Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
End With
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True

        
q = MsgBox("Вы уверены что хотите сохранить данные в ЖУРНАЛ РЕЕСТРА НА ОГРУЗКУ???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
    ' Dim lStartSheet_("Реестр на отгрузку") As Long, lEndSheet_("Реестр на отгрузку") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Реестр на отгрузку")" и "shSheet_("журнал реестра на отгрузку")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Реестр на отгрузку")
    Set shSheett = Worksheets("журнал реестра на отгрузку")
    lStartSheet = 11
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
    For i = lStartSheet To lEndSheet
    If Not shSheetf.Cells(i, 1).Value = Empty Then
    'Перносим данные на второй лист.
    shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
    For X = 2 To 12
    shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
    Next X
    'Изменяем переменную "lLastRow",
    'чтобы данные уже вставлять в следующую строку.
    lLastRow = lLastRow + 1
    End If
    Next i
    Range(Cells(11, 1), Cells(lEndSheet, 70)).ClearContents
    
    MsgBox "Данные перенесены на Лист Журнал реестра на отгрузку..."
    
End Sub
[/vba]


Кто бы ты ни был, мир в твоих руках
 
Ответить
Сообщениеdevilkurs, СПАСИБО ОГРОМНЕЙШЕЕ все сработало на УРА :hands:
Только прошу вас помочь, можно ли дополнить код еще одним действием???
Как удалить сохраненный файл после отправки???
[vba]
Код

Private Sub CommandButton5_Click() 'Код для сохранения данных на лист Журнал реестра на отгрузку

q = MsgBox("Вы уверены что хотите сохранить в PDF???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код сохранения
Range(ActiveSheet.PageSetup.PrintArea).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\a.anisimov\Desktop\Диспечерезация(2).pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

q = MsgBox("Вы уверены что хотите отправить сохраненный файл по почте???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код для отправки данного файла на почту Outlook
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
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 = "a.anisimov@gradindustry.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
sSubject = "Реестр на отгрузку"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
sBody = "Здравствуйте направляю вам реестр на отгрузку"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
sAttachment = "C:\Users\a.anisimov\Desktop\Диспечерезация(2).pdf"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
'создаем сообщение
With objMail
.To = sTo 'адрес получателя
.CC = "" 'адрес для копии
.BCC = "" 'адрес для скрытой копии
.Subject = sSubject 'тема сообщения
.Body = sBody 'текст сообщения
'.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
.Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
.Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
End With
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True

        
q = MsgBox("Вы уверены что хотите сохранить данные в ЖУРНАЛ РЕЕСТРА НА ОГРУЗКУ???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
    ' Dim lStartSheet_("Реестр на отгрузку") As Long, lEndSheet_("Реестр на отгрузку") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Реестр на отгрузку")" и "shSheet_("журнал реестра на отгрузку")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Реестр на отгрузку")
    Set shSheett = Worksheets("журнал реестра на отгрузку")
    lStartSheet = 11
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
    For i = lStartSheet To lEndSheet
    If Not shSheetf.Cells(i, 1).Value = Empty Then
    'Перносим данные на второй лист.
    shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
    For X = 2 To 12
    shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
    Next X
    'Изменяем переменную "lLastRow",
    'чтобы данные уже вставлять в следующую строку.
    lLastRow = lLastRow + 1
    End If
    Next i
    Range(Cells(11, 1), Cells(lEndSheet, 70)).ClearContents
    
    MsgBox "Данные перенесены на Лист Журнал реестра на отгрузку..."
    
End Sub
[/vba]

Автор - lebensvoll
Дата добавления - 09.09.2016 в 11:35
lebensvoll Дата: Пятница, 09.09.2016, 11:42 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
А также вопрос???
А как изменить название в сохранении PDF файла??? Сейчас он сохраняет его по наименованию файла (((( а хотелось бы по наименованию ЛИСТА


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеА также вопрос???
А как изменить название в сохранении PDF файла??? Сейчас он сохраняет его по наименованию файла (((( а хотелось бы по наименованию ЛИСТА

Автор - lebensvoll
Дата добавления - 09.09.2016 в 11:42
devilkurs Дата: Пятница, 09.09.2016, 12:28 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 43 ±
Замечаний: 0% ±

Excel 2007, 2010
lebensvoll,
день добрый. рад что помог.

А как изменить название в сохранении PDF файла

Объявление переменной поднимите на вверх макроса:
[vba]
Код
sAttachment As String
[/vba]
Там же вверху сразу присвойте переменной значение и переменную используйте везде по коду
[vba]
Код
sAttachment = "C:/Temp/" & ActiveSheet.Name & ".pdf"
[/vba]
Я лично использую виндовскую папку Темп для этих действий. И получите путь в папку Темп с Именем активного листа в имя файла
Как удалить сохраненный файл после отправки???

[vba]
Код

If Dir(sAttachment , 16) = "" Then
  MsgBox "Нет такого файла", vbCritical, "Ошибка"
else
  Kill sAttachment
end if
[/vba]
Единственное я не знаю успеет ли взять Аутлук файл ПДФ до его удаления. Не проверял - не знаю.


 
Ответить
Сообщениеlebensvoll,
день добрый. рад что помог.

А как изменить название в сохранении PDF файла

Объявление переменной поднимите на вверх макроса:
[vba]
Код
sAttachment As String
[/vba]
Там же вверху сразу присвойте переменной значение и переменную используйте везде по коду
[vba]
Код
sAttachment = "C:/Temp/" & ActiveSheet.Name & ".pdf"
[/vba]
Я лично использую виндовскую папку Темп для этих действий. И получите путь в папку Темп с Именем активного листа в имя файла
Как удалить сохраненный файл после отправки???

[vba]
Код

If Dir(sAttachment , 16) = "" Then
  MsgBox "Нет такого файла", vbCritical, "Ошибка"
else
  Kill sAttachment
end if
[/vba]
Единственное я не знаю успеет ли взять Аутлук файл ПДФ до его удаления. Не проверял - не знаю.

Автор - devilkurs
Дата добавления - 09.09.2016 в 12:28
lebensvoll Дата: Пятница, 09.09.2016, 13:03 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
devilkurs, сейчас попробую


Кто бы ты ни был, мир в твоих руках
 
Ответить
Сообщениеdevilkurs, сейчас попробую

Автор - lebensvoll
Дата добавления - 09.09.2016 в 13:03
lebensvoll Дата: Пятница, 09.09.2016, 13:35 | Сообщение № 10
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
devilkurs, вроде бы все удачно получилось (можно сказать справился с вашими наставлениями) но с одним НО ((((
В первую очередь данный файл при открытии аутлука не был приложен ((((( и можно сказать зависло (((( я отменил отправку.
Вот мой код как я понял (если правильно конечно же)
[vba]
Код
Private Sub CommandButton5_Click() 'Код для сохранения данных на лист Журнал реестра на отгрузку

q = MsgBox("Вы уверены что хотите сохранить в PDF???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код сохранения
Dim sAttachment As String
sAttachment = "C:/Temp/" & ActiveSheet.Name & ".pdf"
Range(ActiveSheet.PageSetup.PrintArea).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:/Temp/" & ActiveSheet.Name & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

q = MsgBox("Вы уверены что хотите отправить сохраненный файл по почте???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код для отправки данного файла на почту Outlook
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String
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 = "e.tatchenkova@m-uptk.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
sSubject = "Реестр на отгрузку"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
sBody = "Здравствуйте направляю вам реестр на отгрузку"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
sAttachment = "C:/Temp/" & ActiveSheet.Name & ".pdf"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
'создаем сообщение
With objMail
.To = sTo 'адрес получателя
.CC = "" 'адрес для копии
.BCC = "" 'адрес для скрытой копии
.Subject = sSubject 'тема сообщения
.Body = sBody 'текст сообщения
'.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
.Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
.Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
End With
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True

        
q = MsgBox("Вы уверены что хотите сохранить данные в ЖУРНАЛ РЕЕСТРА НА ОГРУЗКУ???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
    ' Dim lStartSheet_("Реестр на отгрузку") As Long, lEndSheet_("Реестр на отгрузку") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Реестр на отгрузку")" и "shSheet_("журнал реестра на отгрузку")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Реестр на отгрузку")
    Set shSheett = Worksheets("журнал реестра на отгрузку")
    lStartSheet = 11
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
    For i = lStartSheet To lEndSheet
    If Not shSheetf.Cells(i, 1).Value = Empty Then
    'Перносим данные на второй лист.
    shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
    For X = 2 To 12
    shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
    Next X
    'Изменяем переменную "lLastRow",
    'чтобы данные уже вставлять в следующую строку.
    lLastRow = lLastRow + 1
    End If
    Next i
    Range(Cells(11, 1), Cells(lEndSheet, 70)).ClearContents
    MsgBox "Данные перенесены на Лист Журнал реестра на отгрузку..."
    
    q = MsgBox("Вы уверены что хотите удалить PDF файл из папки Temp???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
    If Dir(sAttachment, 16) = "" Then
MsgBox "Нет такого файла", vbCritical, "Ошибка"
Else
Kill sAttachment
End If
    
End Sub
[/vba]


Кто бы ты ни был, мир в твоих руках
 
Ответить
Сообщениеdevilkurs, вроде бы все удачно получилось (можно сказать справился с вашими наставлениями) но с одним НО ((((
В первую очередь данный файл при открытии аутлука не был приложен ((((( и можно сказать зависло (((( я отменил отправку.
Вот мой код как я понял (если правильно конечно же)
[vba]
Код
Private Sub CommandButton5_Click() 'Код для сохранения данных на лист Журнал реестра на отгрузку

q = MsgBox("Вы уверены что хотите сохранить в PDF???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код сохранения
Dim sAttachment As String
sAttachment = "C:/Temp/" & ActiveSheet.Name & ".pdf"
Range(ActiveSheet.PageSetup.PrintArea).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:/Temp/" & ActiveSheet.Name & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

q = MsgBox("Вы уверены что хотите отправить сохраненный файл по почте???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код для отправки данного файла на почту Outlook
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String
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 = "e.tatchenkova@m-uptk.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
sSubject = "Реестр на отгрузку"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
sBody = "Здравствуйте направляю вам реестр на отгрузку"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
sAttachment = "C:/Temp/" & ActiveSheet.Name & ".pdf"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
'создаем сообщение
With objMail
.To = sTo 'адрес получателя
.CC = "" 'адрес для копии
.BCC = "" 'адрес для скрытой копии
.Subject = sSubject 'тема сообщения
.Body = sBody 'текст сообщения
'.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
.Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
.Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
End With
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True

        
q = MsgBox("Вы уверены что хотите сохранить данные в ЖУРНАЛ РЕЕСТРА НА ОГРУЗКУ???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий

'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
    ' Dim lStartSheet_("Реестр на отгрузку") As Long, lEndSheet_("Реестр на отгрузку") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Реестр на отгрузку")" и "shSheet_("журнал реестра на отгрузку")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Реестр на отгрузку")
    Set shSheett = Worksheets("журнал реестра на отгрузку")
    lStartSheet = 11
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
    For i = lStartSheet To lEndSheet
    If Not shSheetf.Cells(i, 1).Value = Empty Then
    'Перносим данные на второй лист.
    shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
    For X = 2 To 12
    shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
    Next X
    'Изменяем переменную "lLastRow",
    'чтобы данные уже вставлять в следующую строку.
    lLastRow = lLastRow + 1
    End If
    Next i
    Range(Cells(11, 1), Cells(lEndSheet, 70)).ClearContents
    MsgBox "Данные перенесены на Лист Журнал реестра на отгрузку..."
    
    q = MsgBox("Вы уверены что хотите удалить PDF файл из папки Temp???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
    If Dir(sAttachment, 16) = "" Then
MsgBox "Нет такого файла", vbCritical, "Ошибка"
Else
Kill sAttachment
End If
    
End Sub
[/vba]

Автор - lebensvoll
Дата добавления - 09.09.2016 в 13:35
devilkurs Дата: Пятница, 09.09.2016, 16:28 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 43 ±
Замечаний: 0% ±

Excel 2007, 2010
lebensvoll, Мой косяк ((((( не те слеши написал
вместо
[vba]
Код
"C:/Temp/"
[/vba]
надо
[vba]
Код
"C:\TEMP\"
[/vba]

И еще. Вы же один раз объявили в переменную sAttachment полный путь файла, далее по коду его и используйте. Я поправил.
Только проверьте что после отработки макроса отправляется в письме файл. Вообще на сколько я знаю при добавлении файла в письмо аутлука, это файл копируется во временную папку аутлука, поэтому удаление созданного макросом файла не повлияет на отправку.


 
Ответить
Сообщениеlebensvoll, Мой косяк ((((( не те слеши написал
вместо
[vba]
Код
"C:/Temp/"
[/vba]
надо
[vba]
Код
"C:\TEMP\"
[/vba]

И еще. Вы же один раз объявили в переменную sAttachment полный путь файла, далее по коду его и используйте. Я поправил.
Только проверьте что после отработки макроса отправляется в письме файл. Вообще на сколько я знаю при добавлении файла в письмо аутлука, это файл копируется во временную папку аутлука, поэтому удаление созданного макросом файла не повлияет на отправку.

Автор - devilkurs
Дата добавления - 09.09.2016 в 16:28
devilkurs Дата: Пятница, 09.09.2016, 16:29 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 43 ±
Замечаний: 0% ±

Excel 2007, 2010




Сообщение отредактировал devilkurs - Пятница, 09.09.2016, 16:34
 
Ответить
Сообщение

Автор - devilkurs
Дата добавления - 09.09.2016 в 16:29
lebensvoll Дата: Вторник, 13.09.2016, 10:46 | Сообщение № 13
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
devilkurs, Данный код сработал и вы правы ошибка в /// а нужно \\\
но теперь данный код хотел применить к другому листу и когда он доходит до кода для сохранения в ПДФ (((( ругается (я так понимаю потому что у меня теперь стало две ОБЛАСТИ ПЕЧАТИ, возможно я ошибаюсь) но не могу что то либо исправить (((( :'( :'( :'(
[img][/img]

ПОМОГИТЕ пожалуйста как поправить данную ошибку
[img][/img]


Кто бы ты ни был, мир в твоих руках
 
Ответить
Сообщениеdevilkurs, Данный код сработал и вы правы ошибка в /// а нужно \\\
но теперь данный код хотел применить к другому листу и когда он доходит до кода для сохранения в ПДФ (((( ругается (я так понимаю потому что у меня теперь стало две ОБЛАСТИ ПЕЧАТИ, возможно я ошибаюсь) но не могу что то либо исправить (((( :'( :'( :'(
[img][/img]

ПОМОГИТЕ пожалуйста как поправить данную ошибку
[img][/img]

Автор - lebensvoll
Дата добавления - 13.09.2016 в 10:46
lebensvoll Дата: Вторник, 13.09.2016, 11:16 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
да ну почему же он ругаться то стал (((( не могу понять!!!
[vba]
Код
'Код сохранения в ПДФ
    Dim sAttachment As String
    sAttachment = "C:\TEMP\" & Replace(ActiveSheet.Name, " ", "_") & ".pdf"
    
    Range(ActiveSheet.PageSetup.PrintArea).ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:=sAttachment, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
[/vba]
:'(


Кто бы ты ни был, мир в твоих руках
 
Ответить
Сообщениеда ну почему же он ругаться то стал (((( не могу понять!!!
[vba]
Код
'Код сохранения в ПДФ
    Dim sAttachment As String
    sAttachment = "C:\TEMP\" & Replace(ActiveSheet.Name, " ", "_") & ".pdf"
    
    Range(ActiveSheet.PageSetup.PrintArea).ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:=sAttachment, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
[/vba]
:'(

Автор - lebensvoll
Дата добавления - 13.09.2016 в 11:16
Матраскин Дата: Вторник, 13.09.2016, 11:27 | Сообщение № 15
Группа: Друзья
Ранг: Обитатель
Сообщений: 375
Репутация: 81 ±
Замечаний: 0% ±

20xx
lebensvoll,
[vba]
Код
ActiveSheet.PageSetup.PrintArea
[/vba] а такой диапазон существует и он верный? ошибка говорит, что с ним проблема ЖЕ


в интернете опять кто-то не прав

Сообщение отредактировал Матраскин - Вторник, 13.09.2016, 11:31
 
Ответить
Сообщениеlebensvoll,
[vba]
Код
ActiveSheet.PageSetup.PrintArea
[/vba] а такой диапазон существует и он верный? ошибка говорит, что с ним проблема ЖЕ

Автор - Матраскин
Дата добавления - 13.09.2016 в 11:27
lebensvoll Дата: Вторник, 13.09.2016, 11:48 | Сообщение № 16
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
Матраскин, конечно есть что самое главное данный код раньше работал и все было хорошо на другом листе. Но когда я его начал применять к другому листу (((( то сначала он также работал а теперь (((( ругается ((((
[img][/img]


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеМатраскин, конечно есть что самое главное данный код раньше работал и все было хорошо на другом листе. Но когда я его начал применять к другому листу (((( то сначала он также работал а теперь (((( ругается ((((
[img][/img]

Автор - lebensvoll
Дата добавления - 13.09.2016 в 11:48
Матраскин Дата: Вторник, 13.09.2016, 11:53 | Сообщение № 17
Группа: Друзья
Ранг: Обитатель
Сообщений: 375
Репутация: 81 ±
Замечаний: 0% ±

20xx
lebensvoll, сложно вот так без файла))
1.Пока я вижу что имя ему Область печати, а я не знаю чё там в PrintArea.


в интернете опять кто-то не прав

Сообщение отредактировал Матраскин - Вторник, 13.09.2016, 11:54
 
Ответить
Сообщениеlebensvoll, сложно вот так без файла))
1.Пока я вижу что имя ему Область печати, а я не знаю чё там в PrintArea.

Автор - Матраскин
Дата добавления - 13.09.2016 в 11:53
lebensvoll Дата: Вторник, 13.09.2016, 12:09 | Сообщение № 18
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
Матраскин, вот файл но без листа для сохранения ((((
К сообщению приложен файл: 0576882.xlsm(36Kb)


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеМатраскин, вот файл но без листа для сохранения ((((

Автор - lebensvoll
Дата добавления - 13.09.2016 в 12:09
Матраскин Дата: Вторник, 13.09.2016, 12:21 | Сообщение № 19
Группа: Друзья
Ранг: Обитатель
Сообщений: 375
Репутация: 81 ±
Замечаний: 0% ±

20xx
lebensvoll, хм, у меня только что отработал без проблем


в интернете опять кто-то не прав

Сообщение отредактировал Матраскин - Вторник, 13.09.2016, 12:21
 
Ответить
Сообщениеlebensvoll, хм, у меня только что отработал без проблем

Автор - Матраскин
Дата добавления - 13.09.2016 в 12:21
lebensvoll Дата: Вторник, 13.09.2016, 12:30 | Сообщение № 20
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 2 ±
Замечаний: 20% ±

Excel 2010
тогда я воообще ни чего не пойму ((((
Я и говорю что у меня вчера все работало также и без проблем (((( единственная проблема возникла при сохранении данных на другой лист но это другая тема и я знаю что там нужно изменить но ругаться на сохранение активного листа не было (((( может комп перегрузить???


Кто бы ты ни был, мир в твоих руках
 
Ответить
Сообщениетогда я воообще ни чего не пойму ((((
Я и говорю что у меня вчера все работало также и без проблем (((( единственная проблема возникла при сохранении данных на другой лист но это другая тема и я знаю что там нужно изменить но ругаться на сохранение активного листа не было (((( может комп перегрузить???

Автор - lebensvoll
Дата добавления - 13.09.2016 в 12:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вывести таблицу в PDF и отправить ее через outlook (Макросы/Sub)
Страница 1 из 212»
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!