Note: The other languages of the website are Google-translated. Back to English
Войти Регистрация

Как сохранить рабочий лист в виде файла PDF и отправить его по электронной почте в виде вложения через Outlook?

В некоторых случаях вам может потребоваться отправить рабочий лист в виде файла PDF через Outlook. Обычно вам нужно вручную сохранить рабочий лист как файл PDF, затем создать новое электронное письмо с этим файлом PDF в качестве вложения в Outlook и, наконец, отправить его. Это требует времени, чтобы сделать это вручную, шаг за шагом. В этой статье мы покажем вам, как быстро сохранить рабочий лист в виде файла PDF и автоматически отправить его в виде вложения через Outlook в Excel.

Сохраните рабочий лист как PDF-файл и отправьте его по электронной почте как вложение с кодом VBA.

Сохраните рабочий лист как PDF-файл и отправьте его по электронной почте как вложение с кодом VBA.

Вы можете запустить приведенный ниже код VBA, чтобы автоматически сохранить активный лист в виде файла PDF, а затем отправить его по электронной почте как вложение через Outlook. Пожалуйста, сделайте следующее.

1. Откройте рабочий лист, который вы сохраните в формате PDF и отправите, затем нажмите другой + F11 клавиши одновременно, чтобы открыть Microsoft Visual Basic для приложений окно.

2. в Microsoft Visual Basic для приложений окна, нажмите Вставить > Модули. Затем скопируйте и вставьте приведенный ниже код VBA в Код: окно. Смотрите скриншот:

Код VBA: сохраните рабочий лист как файл PDF и отправьте его по электронной почте как вложение

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file 
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    
    'Create Outlook email 
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

3. нажмите F5 ключ для запуска кода. в Приложения диалоговом окне выберите папку для сохранения этого PDF-файла, а затем щелкните OK кнопку.

Заметки:

1. Теперь активный рабочий лист сохранен как файл PDF. И файл PDF называется именем рабочего листа.
2. Если активный рабочий лист пуст, вы получите диалоговое окно, как показано на скриншоте ниже, после нажатия кнопки OK кнопку.

4. Теперь создается новое электронное письмо Outlook, и вы можете видеть, что файл PDF указан как вложение в поле «Прикрепленные». Смотрите скриншот:

5. Составьте это письмо и отправьте его.
6. Этот код доступен только при использовании Outlook в качестве почтовой программы.

С легкостью сохраняйте рабочий лист или несколько рабочих листов в виде отдельных файлов PDF одновременно:

Компания Разделить книгу полезности Kutools for Excel может помочь вам легко сохранить рабочий лист или несколько рабочих листов в виде отдельных файлов PDF одновременно, как показано ниже. Скачайте и попробуйте прямо сейчас! (30- дневная бесплатная трасса)

Статьи по теме:

Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Старейший первый
Новички вперед
Комментарии (62)
Номинальный 5 из 5 · рейтинги 1
Майкл
Майкл
Этот комментарий был сведен к минимуму модератором на сайте
Это отлично работает для меня, но есть ли способ выбрать папку автоматически, а не вручную? Я надеюсь сделать это сразу для 40 листов.
Ответить
0
0
Хью
Хью     Майкл
Этот комментарий был сведен к минимуму модератором на сайте
Также надеюсь увидеть ответ на этот вопрос! Спасибо за помощь!
Ответить
0
0
Даррен
Даррен
Этот комментарий был сведен к минимуму модератором на сайте
Я попытался вставить это в новый модуль, и я получаю сообщение об ошибке компиляции: подпрограмма или функция не определены. Пожалуйста помоги.
Ответить
0
0
кристалл
кристалл     Даррен
Этот комментарий был сведен к минимуму модератором на сайте
Дорогой Даррен,
Какую версию Office вы используете?
Ответить
Report
0
0
Nakia
Nakia     кристалл
Этот комментарий был сведен к минимуму модератором на сайте
Управление 360
Ответить
0
0
Билл
Билл     Даррен
Этот комментарий был сведен к минимуму модератором на сайте
Тот же вопрос
Ответить
0
0
Майкл Чарри
Майкл Чарри
Этот комментарий был сведен к минимуму модератором на сайте
Как мне отредактировать приведенный выше сценарий VBA, чтобы он добавлял отметку даты и времени к имени файла, чтобы он не перезаписывал то, что уже сохранено?
Ответить
Report
0
0
кристалл
кристалл     Майкл Чарри
Этот комментарий был сведен к минимуму модератором на сайте
Дорогой Майкл,
Пожалуйста, запустите приведенный ниже код VBA, чтобы решить проблему.

Подпрограмма Сохранить как PDF и отправить ()
Dim xSht как рабочий лист
Dim xFileDlg как FileDialog
Dim xFolder как строка
Dim xYesorNo как целое число
Dim xOutlookObj как объект
Dim xEmailObj как объект
Dim xUsedRng как диапазон
Dim xStr как строка

Установите xSht = ActiveSheet
Установите xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Если xFileDlg.Show = True Тогда
xFolder = xFileDlg.SelectedItems(1)
Еще
MsgBox "Необходимо указать папку для сохранения PDF-файла." & vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Необходимо указать папку назначения"
Exit Sub
End If
xStr = Формат(Сейчас(), "гггг-мм-дд-чч-мм-сс")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Проверить, существует ли уже файл
Если Лен(Каталог(xFolder)) > 0 Тогда
xYesorNo = MsgBox(xFolder & "уже существует." & vbCrLf & vbCrLf & "Хотите перезаписать?", _
vbYesNo + vbQuestion, "Файл существует")
On Error Resume Next
Если xYesилиNo = vbДа Тогда
Убить xFolder
Еще
MsgBox «Если вы не перезапишете существующий PDF-файл, я не смогу продолжить». _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Выход из макроса"
Exit Sub
End If
Если Err.Number <> 0 Тогда
MsgBox "Невозможно удалить существующий файл. Убедитесь, что файл не открыт и не защищен от записи." _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Невозможно удалить файл"
Exit Sub
End If
End If

Установите xUsedRng = xSht.UsedRange
Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда
'Сохранить как файл PDF
xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xFolder, Качество:=xlQualityStandard

'Создать электронную почту Outlook
Установите xOutlookObj = CreateObject("Outlook.Application")
Установите xEmailObj = xOutlookObj.CreateItem(0)
С xEmailObj
.Отображать
.К = ""
.CC = ""
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Attachments.Добавить xFolder
Если DisplayEmail = Ложь Тогда
'.Отправлять
End If
Конец с
Еще
MsgBox "Активный рабочий лист не может быть пустым"
Exit Sub
End If
End Sub
Ответить
Report
0
0
Параг Сомани
Параг Сомани     кристалл
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Кристал,

Это действительно здорово и отлично работает для меня. Нужна дополнительная помощь, чтобы добавить:

1. в «Кому» я хочу дать ссылку на конкретную ячейку активного листа, как в CC, а в BCC я хотел бы добавить ссылку на активный лист
2. в теле письма мне нужно указать стандартный текст.

Буду очень благодарен вам за вашу помощь.

Спасибо
Параг
Ответить
0
0
кристалл
кристалл     Параг Сомани
Этот комментарий был сведен к минимуму модератором на сайте
Привет Параг Сомани,
Приведенный ниже код VBA может вам помочь. Измените поля .To, .CC, .BCC и .Body в соответствии с вашими потребностями.

Подпрограмма Сохранить как PDF и отправить ()
Dim xSht как рабочий лист
Dim xFileDlg как FileDialog
Dim xFolder как строка
Dim xYesorNo как целое число
Dim xOutlookObj как объект
Dim xEmailObj как объект
Dim xUsedRng как диапазон
Dim xStr как строка

Установите xSht = ActiveSheet
Установите xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Если xFileDlg.Show = True Тогда
xFolder = xFileDlg.SelectedItems(1)
Еще
MsgBox "Необходимо указать папку для сохранения PDF-файла." & vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Необходимо указать папку назначения"
Exit Sub
End If
xStr = Формат(Сейчас(), "гггг-мм-дд-чч-мм-сс")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Проверить, существует ли уже файл
Если Лен(Каталог(xFolder)) > 0 Тогда
xYesorNo = MsgBox(xFolder & "уже существует." & vbCrLf & vbCrLf & "Хотите перезаписать?", _
vbYesNo + vbQuestion, "Файл существует")
On Error Resume Next
Если xYesилиNo = vbДа Тогда
Убить xFolder
Еще
MsgBox «Если вы не перезапишете существующий PDF-файл, я не смогу продолжить». _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Выход из макроса"
Exit Sub
End If
Если Err.Number <> 0 Тогда
MsgBox "Невозможно удалить существующий файл. Убедитесь, что файл не открыт и не защищен от записи." _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Невозможно удалить файл"
Exit Sub
End If
End If

Установите xUsedRng = xSht.UsedRange
Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда
'Сохранить как файл PDF
xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xFolder, Качество:=xlQualityStandard

'Создать электронную почту Outlook
Установите xOutlookObj = CreateObject("Outlook.Application")
Установите xEmailObj = xOutlookObj.CreateItem(0)
С xEmailObj
.Отображать
.To = Диапазон ("A8")
.CC = Диапазон ("A9")
.BCC = Диапазон ("A10")
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Body = "Дорогой" _
& vbNewLine & vbNewLine & _
"Это тестовое письмо" & _
"отправка в Excel"
.Attachments.Добавить xFolder
Если DisplayEmail = Ложь Тогда
'.Отправлять
End If
Конец с
Еще
MsgBox "Активный рабочий лист не может быть пустым"
Exit Sub
End If
End Sub
Ответить
Report
0
0
Mehul
Mehul     кристалл
Этот комментарий был сведен к минимуму модератором на сайте
Я пытался использовать диапазон для «Кому», «Копия», он просто не берет значения из указанной ячейки. Не могли бы вы помочь в этом?
Благодаря,
Mehul
Ответить
0
0
Параг Сомани
Параг Сомани     кристалл
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Кристал,

Это действительно здорово и отлично работает для меня. Нужна дополнительная помощь, чтобы добавить:

1. в «Кому» я хочу дать ссылку на конкретную ячейку активного листа, как в CC, а в BCC я хотел бы добавить ссылку на активный лист
2. в теле письма мне нужно указать стандартный текст.

Буду очень благодарен вам за вашу помощь.

Спасибо
Параг
Ответить
0
0
Параг
Параг     кристалл
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Кристал,

Это действительно здорово и отлично работает для меня. Нужна дополнительная помощь, чтобы добавить:

1. в «Кому» я хочу дать ссылку на конкретную ячейку активного листа, как в CC, а в BCC я хотел бы добавить ссылку на активный лист
2. в теле письма мне нужно указать стандартный текст.

Буду очень благодарен вам за вашу помощь.

Спасибо
Параг
Ответить
Report
0
0
Армин
Армин
Этот комментарий был сведен к минимуму модератором на сайте
Как я могу добавить, например, лист 2 из книги в формате pdf?
Ответить
0
0
кристалл
кристалл     Армин
Этот комментарий был сведен к минимуму модератором на сайте
Привет Армин,
Сначала вам нужно открыть лист 2 в своей книге, а затем запустить код VBA с помощью описанных выше шагов, чтобы его отключить.
Ответить
Report
0
0
Том ч
Том ч
Этот комментарий был сведен к минимуму модератором на сайте
Как мне отредактировать приведенный выше сценарий VBA, чтобы имя файла сохранялось как конкретная ячейка, выбранная на текущем листе, например, ячейка A1?
Ответить
0
0
кристалл
кристалл     Том ч
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Том.
Извините, не могу помочь с этим.
Добро пожаловать, чтобы разместить любой вопрос на нашем форуме: https://www.extendoffice.com/forum.html
Вы получите дополнительную поддержку Excel от профессионалов Excel или других поклонников Excel.
Ответить
Report
0
0
Джеймс
Джеймс
Этот комментарий был сведен к минимуму модератором на сайте
Привет, как я могу сохранить и отправить pdf с именем книги с текущим кодом VBA? что мне использовать вместо xSht.Name
Ответить
0
0
кристалл
кристалл     Джеймс
Этот комментарий был сведен к минимуму модератором на сайте
Привет Джеймс,
Вы хотите отправить активный рабочий лист в формате pdf и назвать его именем рабочей книги?
Ответить
Report
0
0
Ранга
Ранга
Этот комментарий был сведен к минимуму модератором на сайте
Спасибо, это работает.
Ответить
0
0
Джейсон
Джейсон
Этот комментарий был сведен к минимуму модератором на сайте
Как я могу заставить его удалить сохраненный PDF-файл после его отправки по электронной почте?
Ответить
0
0
кристалл
кристалл     Джейсон
Этот комментарий был сведен к минимуму модератором на сайте
Привет Джейсон,
Извините, пока не могу вам с этим помочь. Вам нужно вручную удалить его после отправки по электронной почте.
Ответить
Report
0
0
Одд-Инге
Одд-Инге
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте,

Можно ли найти имя для pdf по ячейке? Бывший. Ячейка H4


А в ячейке H4 я хочу, чтобы она собиралась из трех разных ячеек. Это возможно?
Ответить
0
0
Тейлор
Тейлор     Одд-Инге
Этот комментарий был сведен к минимуму модератором на сайте
Это возможно. Создайте отдельные переменные для хранения значений из ячеек, а затем используйте эти переменные при настройке xFolder.
Я использовал значение из ячейки на моем листе плюс сегодняшнюю дату. Однако вы можете легко сделать несколько значений ячеек.

Вот что я добавил:
Dim xMemberName как строка
Dim xFileDate как строка

xMemberName = Диапазон ("H3"). Значение
xFileDate = Формат (теперь "мм-дд")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
Ответить
0
0
Сора
Сора     Тейлор
Этот комментарий был сведен к минимуму модератором на сайте
Я получаю сообщение об ошибке, когда пытаюсь это сделать, где в коде я должен это разместить?
Ответить
0
0
Кишор
Кишор
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Кристал,



Это действительно здорово и отлично работает для меня. Нужна дополнительная помощь, чтобы добавить:

1. в «Тело» я хочу дать ссылку на конкретную ячейку активного листа. Далее Хотел бы выделить текст жирным шрифтом.

Спасибо

С уважением

Кишоре Кумар
Ответить
Report
0
0
кристалл
кристалл     Кишор
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте,

Вы хотите автоматически добавить значение ячейки в тело письма и выделить его жирным шрифтом? Предположим, вы добавили значение C4 в тело письма. Пожалуйста, примените приведенный ниже код.

Подпрограмма Сохранить как PDF и отправить ()

Dim xSht как рабочий лист

Dim xFileDlg как FileDialog

Dim xFolder как строка

Dim xYesorNo как целое число

Dim xOutlookObj как объект

Dim xEmailObj как объект

Dim xUsedRng как диапазон



Установите xSht = ActiveSheet

Установите xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)



Если xFileDlg.Show = True Тогда

xFolder = xFileDlg.SelectedItems(1)

Еще

MsgBox "Необходимо указать папку для сохранения PDF-файла." & vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Необходимо указать папку назначения"

Exit Sub

End If

xFolder = xFolder + "\" + xSht.Name + ".pdf"



'Проверить, существует ли уже файл

Если Лен(Каталог(xFolder)) > 0 Тогда

xYesorNo = MsgBox(xFolder & "уже существует." & vbCrLf & vbCrLf & "Хотите перезаписать?", _

vbYesNo + vbQuestion, "Файл существует")

On Error Resume Next

Если xYesилиNo = vbДа Тогда

Убить xFolder

Еще

MsgBox «Если вы не перезапишете существующий PDF-файл, я не смогу продолжить». _

& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Выход из макроса"

Exit Sub

End If

Если Err.Number <> 0 Тогда

MsgBox "Невозможно удалить существующий файл. Убедитесь, что файл не открыт и не защищен от записи." _

& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Невозможно удалить файл"

Exit Sub

End If

End If



Установите xUsedRng = xSht.UsedRange

Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда

'Сохранить как файл PDF

xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xFolder, Качество:=xlQualityStandard



'Создать электронную почту Outlook

Установите xOutlookObj = CreateObject("Outlook.Application")

Установите xEmailObj = xOutlookObj.CreateItem(0)

С xEmailObj

.Отображать

.К = ""

.CC = ""

.Subject = xSht.Name + ".pdf"

.Attachments.Добавить xFolder

.HTMLBody = "
" & Диапазон ("C4") & .HTMLBody

Если DisplayEmail = Ложь Тогда

'.Отправлять

End If

Конец с

Еще

MsgBox "Активный рабочий лист не может быть пустым"

Exit Sub

End If

End Sub
Ответить
Report
0
0
Джеф
Джеф
Этот комментарий был сведен к минимуму модератором на сайте
Если бы я хотел, чтобы он автоматически сохранялся в определенной папке каждый раз (избавляя пользователя от необходимости выбирать папку), как бы я это сделал?
Бывший. C: Счета/Северная Америка/Клиенты
Помощь очень ценится.
Ответить
0
0
кристалл
кристалл     Джеф
Этот комментарий был сведен к минимуму модератором на сайте
Привет Джеф,
Вы имеете в виду сохранить рабочий лист в виде файла PDF и сохранить в определенную папку без отправки?
Ответить
Report
0
0
Джереми
Джереми     кристалл
Этот комментарий был сведен к минимуму модератором на сайте
Я думаю, что Джефф имеет в виду возможность указать конкретную папку в коде, в который каждый раз сохраняется PDF-файл, вместо того, чтобы выбирать местоположение вручную. Затем PDF-файл отправляется по электронной почте из этой конкретной папки.
Ответить
0
0
кристалл
кристалл     Джереми
Этот комментарий был сведен к минимуму модератором на сайте
Спасибо, Джереми.
Ответить
Report
0
0
кристалл
кристалл     Джеф
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Джефф! Если вы хотите автоматически сохранить файл PDF в определенную папку, а не выбирать местоположение вручную, попробуйте приведенный ниже код. Не забудьте изменить путь к папке в коде.
Подпрограмма СохранитьКакPDFandSend()
Dim xSht как рабочий лист
Dim xFileDlg как FileDialog
Dim xFolder как строка
Dim xYesorNo как целое число
Dim xOutlookObj как объект
Dim xEmailObj как объект
Dim xUsedRng как диапазон
Dim xPath как строка
Установите xSht = ActiveSheet
хПуть = "C:\Users\Win10x64Test\Desktop\лист в pdf«Здесь «рабочий лист в pdf» — это папка назначения для сохранения файлов pdf.
xFolder = xPath + "\" + xSht.Name + ".pdf"
Если Лен(Каталог(xFolder)) > 0 Тогда
xYesorNo = MsgBox(xFolder & "уже существует." & vbCrLf & vbCrLf & "Хотите перезаписать?", _
vbYesNo + vbQuestion, "Файл существует")
On Error Resume Next
Если xYesилиNo = vbДа Тогда
Убить xFolder
Еще
MsgBox «Если вы не перезапишете существующий PDF-файл, я не смогу продолжить». _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Выход из макроса"
Exit Sub
End If
Если Err.Number <> 0 Тогда
MsgBox "Невозможно удалить существующий файл. Убедитесь, что файл не открыт и не защищен от записи." _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Невозможно удалить файл"
Exit Sub
End If
End If

Установите xUsedRng = xSht.UsedRange
Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда
'Сохранить как файл PDF
xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xFolder, Качество:=xlQualityStandard

'Создать электронную почту Outlook
Установите xOutlookObj = CreateObject("Outlook.Application")
Установите xEmailObj = xOutlookObj.CreateItem(0)
С xEmailObj
.Отображать
.К = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Добавить xFolder
Если DisplayEmail = Ложь Тогда
'.Отправлять
End If
Конец с
Еще
MsgBox "Активный рабочий лист не может быть пустым"
Exit Sub
End If
End Sub
Ответить
Report
0
0
Элисон
Элисон
Этот комментарий был сведен к минимуму модератором на сайте
Этот код отлично работает, за исключением того, что я хочу, чтобы рабочий лист был сохранен как имя листа + дата (например, Sheet1 1 октября 2020 г.); на рабочем столе пользователя (это будет использоваться несколькими людьми, и их пути могут незначительно отличаться). Если возможно, я также хочу встроить .jpg в тело. JPG находится как внутри рабочего листа (за пределами области печати), так и изображение хранится на общем сервере.. хотя путь к серверу зависит от пользователя (для большинства это диск «T», для некоторых диск «U»)
это можно сделать? пожалуйста и спасибо миллион раз.
Ответить
0
0
Дипак
Дипак
Этот комментарий был сведен к минимуму модератором на сайте

Привет, это отлично работает, спасибо, что поделились, просто нужна помощь.
Если я хочу сохранить PDF-файл с настроенным именем (возможность ввода имени файла в диалоговом окне «Сохранить как»), пользователь может использовать эту опцию в шаблоне формы, где формы сохраняются в формате PDF с уникальным именем.
Ответить
Report
0
0
кристалл
кристалл     Дипак
Этот комментарий был сведен к минимуму модератором на сайте
Привет, попробуйте приведенный ниже код VBA. После запуска кода выберите папку для сохранения файла PDF, после чего появится диалоговое окно, в котором нужно ввести имя файла. Подпрограмма Сохранить как PDF и отправить ()
'Обновлено Extendoffice 20210209
Dim xSht как рабочий лист
Dim xFileDlg как FileDialog
Dim xFolder как строка
Dim xYesorNo как целое число
Dim xOutlookObj как объект
Dim xEmailObj как объект
Dim xUsedRng как диапазон
Dim xStrName как строка
Размер xV как вариант

Установите xSht = ActiveSheet
Установите xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Если xFileDlg.Show = True Тогда
xFolder = xFileDlg.SelectedItems(1)
Еще
MsgBox "Необходимо указать папку для сохранения PDF-файла." & vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Необходимо указать папку назначения"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox («Пожалуйста, введите имя файла:», «Kutools for Excel», , , , , , 2)
Если xV = Ложь Тогда
Exit Sub
End If
xStrName = xV
Если xStrName = "" Тогда
MsgBox ("Имя файла не введено, выход из процесса!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Проверить, существует ли уже файл
Если Лен(Каталог(xFolder)) > 0 Тогда
xYesorNo = MsgBox(xFolder & "уже существует." & vbCrLf & vbCrLf & "Хотите перезаписать?", _
vbYesNo + vbQuestion, "Файл существует")
On Error Resume Next
Если xYesилиNo = vbДа Тогда
Убить xFolder
Еще
MsgBox «Если вы не перезапишете существующий PDF-файл, я не смогу продолжить». _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Выход из макроса"
Exit Sub
End If
Если Err.Number <> 0 Тогда
MsgBox "Невозможно удалить существующий файл. Убедитесь, что файл не открыт и не защищен от записи." _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Невозможно удалить файл"
Exit Sub
End If
End If

Установите xUsedRng = xSht.UsedRange
Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда
'Сохранить как файл PDF
xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xFolder, Качество:=xlQualityStandard

'Создать электронную почту Outlook
Установите xOutlookObj = CreateObject("Outlook.Application")
Установите xEmailObj = xOutlookObj.CreateItem(0)
С xEmailObj
.Отображать
.К = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Добавить xFolder
Если DisplayEmail = Ложь Тогда
'.Отправлять
End If
Конец с
Еще
MsgBox "Активный рабочий лист не может быть пустым"
Exit Sub
End If
End Sub
Ответить
Report
0
0
млецус94
млецус94
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте,
Если у меня есть два листа в файле, и я хочу запустить этот макрос на одном листе (нажав кнопку), но отправить другой, как я могу его получить?
Ответить
Report
0
0
хм
хм
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, я хотел бы сохранить это в определенном месте файла с именем, основанным на значении в ячейке C30. Я пробовал несколько вариантов, но продолжаю получать ошибки.
Ответить
0
0
кристалл
кристалл     хм
Этот комментарий был сведен к минимуму модератором на сайте
Привет Hein, приведенный ниже код может помочь. После запуска кода выберите определенную папку для сохранения файла PDF, затем появится диалоговое окно, в котором вы должны ввести имя файла. Подпрограмма Сохранить как PDF и отправить ()
'Обновлено Extendoffice 20210209
Dim xSht как рабочий лист
Dim xFileDlg как FileDialog
Dim xFolder как строка
Dim xYesorNo как целое число
Dim xOutlookObj как объект
Dim xEmailObj как объект
Dim xUsedRng как диапазон
Dim xStrName как строка
Размер xV как вариант

Установите xSht = ActiveSheet
Установите xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Если xFileDlg.Show = True Тогда
xFolder = xFileDlg.SelectedItems(1)
Еще
MsgBox "Необходимо указать папку для сохранения PDF-файла." & vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Необходимо указать папку назначения"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox («Пожалуйста, введите имя файла:», «Kutools for Excel», , , , , , 2)
Если xV = Ложь Тогда
Exit Sub
End If
xStrName = xV
Если xStrName = "" Тогда
MsgBox ("Имя файла не введено, выход из процесса!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Проверить, существует ли уже файл
Если Лен(Каталог(xFolder)) > 0 Тогда
xYesorNo = MsgBox(xFolder & "уже существует." & vbCrLf & vbCrLf & "Хотите перезаписать?", _
vbYesNo + vbQuestion, "Файл существует")
On Error Resume Next
Если xYesилиNo = vbДа Тогда
Убить xFolder
Еще
MsgBox «Если вы не перезапишете существующий PDF-файл, я не смогу продолжить». _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Выход из макроса"
Exit Sub
End If
Если Err.Number <> 0 Тогда
MsgBox "Невозможно удалить существующий файл. Убедитесь, что файл не открыт и не защищен от записи." _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Невозможно удалить файл"
Exit Sub
End If
End If

Установите xUsedRng = xSht.UsedRange
Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда
'Сохранить как файл PDF
xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xFolder, Качество:=xlQualityStandard

'Создать электронную почту Outlook
Установите xOutlookObj = CreateObject("Outlook.Application")
Установите xEmailObj = xOutlookObj.CreateItem(0)
С xEmailObj
.Отображать
.К = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Добавить xFolder
Если DisplayEmail = Ложь Тогда
'.Отправлять
End If
Конец с
Еще
MsgBox "Активный рабочий лист не может быть пустым"
Exit Sub
End If
End Sub
Ответить
Report
0
0
Hein
Hein     кристалл
Этот комментарий был сведен к минимуму модератором на сайте
Спасибо за это, это здорово, но я хочу, чтобы лист был назван в соответствии с ячейкой A1 на листе 1. место для сохранения в соответствии с A1 на листе 2, например, C:\Users\peete\Dropbox\Screenshots, и отправить по электронной почте адрес электронной почты на листе А3 2, что я уже разработал.
Ответить
0
0
ХайнПитерс
ХайнПитерс     кристалл
Этот комментарий был сведен к минимуму модератором на сайте
Спасибо за это, это здорово, но я хочу, чтобы лист был назван в соответствии с ячейкой A1 на листе 1. место для сохранения в соответствии с A1 на листе 2, например, C:\Users\peete\Dropbox\Screenshots, но может измениться, когда используя файл, и отправьте электронное письмо на адрес электронной почты на листе A3 2, что я уже разработал.
Ответить
Report
0
0
БенСпо
БенСпо
Этот комментарий был сведен к минимуму модератором на сайте
Hi кристалл , отличный код, спасибо, что поделились. Есть ли способ выбрать несколько листов (из одной книги), чтобы сохранить каждый из них как независимый PDF-файл, а затем отправить их все прикрепленными в одном электронном письме?
Ответить
Report
0
0
кристалл
кристалл     БенСпо
Этот комментарий был сведен к минимуму модератором на сайте
Привет, приведенный ниже код VBA может оказать вам услугу, попробуйте. В двенадцатой строке кода замените имена листов фактическими именами листов в вашем случае.
Подпрограмма Сохранить как PDF и отправить1 ()
Dim xSht как рабочий лист
Dim xFileDlg как FileDialog
Dim xFolder как строка
Dim xYesorNo, I, xNum как целое число
Dim xOutlookObj как объект
Dim xEmailObj как объект
Dim xUsedRng как диапазон
Dim xArrShetts как вариант
Dim xPDFNameAddress как строка
Dim xStr как строка
xArrShetts = Массив("тест", "Лист1", "Лист2") 'Введите имена листов, которые вы отправите в виде pdf-файлов, заключенных в кавычки, и разделите их запятыми. Убедитесь, что в имени файла нет специальных символов, таких как \/:"*<>|.

Для I = 0 в UBound(xArrShetts)
On Error Resume Next
Установите xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))
Если xSht.Name <> xArrShetts(I) Тогда
MsgBox «Рабочий лист не найден, операция выхода:» & vbCrLf & vbCrLf & xArrShetts (I), vbInformation, «Kutools for Excel»
Exit Sub
End If
Далее


Установите xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)
Если xFileDlg.Show = True Тогда
xFolder = xFileDlg.SelectedItems(1)
Еще
MsgBox "Необходимо указать папку для сохранения PDF-файла." & vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Необходимо указать папку назначения"
Exit Sub
End If
'Проверить, существует ли уже файл
xYesorNo = MsgBox("Если в папке назначения существуют файлы с одинаковыми именами, к имени файла будет автоматически добавлен цифровой суффикс, чтобы различать дубликаты" & vbCrLf & vbCrLf & "Нажмите Да, чтобы продолжить, нажмите Нет, чтобы отменить", _
vbYesNo + vbQuestion, "Файл существует")
Если xYesorNo <> vbYes, то выйдите из Sub
Для I = 0 в UBound(xArrShetts)
Установите xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
хЧисл = 1
Пока нет (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
хЧисл = хЧисл + 1
венед
Установите xUsedRng = xSht.UsedRange
Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда
xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xStr, Качество:=xlQualityStandard
Еще

End If
xArrShetts(I) = xStr
Далее

'Создать электронную почту Outlook
Установите xOutlookObj = CreateObject("Outlook.Application")
Установите xEmailObj = xOutlookObj.CreateItem(0)
С xEmailObj
.Отображать
.К = ""
.CC = ""
.Тема = "????"
Для I = 0 в UBound(xArrShetts)
.Attachments.Add xArrShetts(I)
Далее
Если DisplayEmail = Ложь Тогда
'.Отправлять
End If
Конец с
End Sub
Ответить
Report
0
0
Берне Рудольф
Берне Рудольф     кристалл
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Единственное изменение, с которым я борюсь, - это создание отдельного электронного письма для каждого созданного документа PDF.
Ответить
0
0
кристалл
кристалл     Берне Рудольф
Этот комментарий был сведен к минимуму модератором на сайте
Привет! Чтобы создать отдельное электронное письмо для каждого PDF-документа, вы можете вручную запустить VBA, указанный в сообщении, на разных листах, чтобы это сделать.
Ответить
Report
0
0
Берне Рудольф
Берне Рудольф     кристалл
Этот комментарий был сведен к минимуму модератором на сайте
У меня более 100 рабочих листов в рабочей книге, что означает, что мне придется запускать VBA более 100 раз, что отнимает много времени.  
Мне удалось разделить мою книгу на несколько листов, а затем я могу преобразовать каждый лист в отдельный документ PDF.
Решение, которое я ищу, состоит в том, чтобы отправлять по электронной почте каждый PDF-документ отдельно, пока выполняется вышеуказанный процесс.
При этом VBA, который я сейчас использую:
Подпрограмма Сохранить как PDF и отправить1 ()
Dim xSht как рабочий лист
Dim xFileDlg как FileDialog
Dim xFolder как строка
Dim xYesorNo, I, xNum как целое число
Dim xOutlookObj как объект
Dim xEmailObj как объект
Dim xUsedRng как диапазон
Dim xArrShetts как вариант
Dim xPDFNameAddress как строка
Dim xStr как строка
xArrShetts = Array("02302257", "02400438", "02401829", "02403995", "02408001", "02409208", _
"02409980", "02411881", "02424178", "02430454", "02444046", "02448950", "02450600", _
"02459861", "02461750", "02467535", "02480484", "02484749", "02502041", "02504807", _
"02511843", "02515193", "02523098", "02523244", "02524036", "02524548", "02525516", "02525703", "02525898", "02528908", "02528950", _
"02530381", "02531018", "02531252", "02531277", "02532571", "02533053", "02533474", _
"02534176", "02534592", "02534626", "02535343", "02536386", "02536921", "02537544", _
"02537607", "02538015", "02538755", "02538836", "02538910", "02539685", "02540063", "02540139", "02540158", "02541607", "02542344", _
"02543763", "02543985", "02544116", "02544748", "02544762", "02545026", "02545048", _
"02545080", "02545447", "02545730", "02545814", "02546477", "02547458", "02547673", _
"02547833", "02547912", "02547950", "02547991", "02548848", "02549103", "02549116", "02549125", "02549132", "02549140", "02549182", _
"02549462", "02549499", "02549565", "02549687", "02550049", "02550437", "02550812", _
"02550982", "02551004", "02551005", "02551045", "02552099", "02552222", "02552561", _
"02552684", "02552815", "02552892", "02553031", "02553186", "02553628", "02553721", "02555186", "02556934", "02557137", "02557393", _
"02559121", "02559392", "02559419", "02559512", "02559802", "02559868", "02560052", _
"02560612", "02560684", "02560920", "02561018", "02561061", "02561092", "02561227", _
"02561349", "02561592", "02561630", "02561673", "02561880", "02562359", "02562920", "02562934", "02563013", "02563119", "02563133", _
"02563445", "02563737", "02563828", "02563852", "02563861", "02563971", "02564042", _
"02564315", "02564366", "02564832", "02564909", "02565059", "02565205") 'Введите имена листов, которые вы будете отправлять в формате pdf, заключенные в кавычки, и разделите их запятой. Убедитесь, что в имени файла нет специальных символов, таких как \/:"*<>|.

Для I = 0 в UBound(xArrShetts)
On Error Resume Next
Установите xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))
Если xSht.Name <> xArrShetts(I) Тогда
MsgBox «Рабочий лист не найден, операция выхода:» & vbCrLf & vbCrLf & xArrShetts (I), vbInformation, «Kutools for Excel»
Exit Sub
End If
Далее


Установите xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)
Если xFileDlg.Show = True Тогда
xFolder = xFileDlg.SelectedItems(1)
Еще
MsgBox "Необходимо указать папку для сохранения PDF-файла." & vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Необходимо указать папку назначения"
Exit Sub
End If
'Проверить, существует ли уже файл
xYesorNo = MsgBox("Если в папке назначения существуют файлы с одинаковыми именами, к имени файла будет автоматически добавлен цифровой суффикс, чтобы различать дубликаты" & vbCrLf & vbCrLf & "Нажмите Да, чтобы продолжить, нажмите Нет, чтобы отменить", _
vbYesNo + vbQuestion, "Файл существует")
Если xYesorNo <> vbYes, то выйдите из Sub
Для I = 0 в UBound(xArrShetts)
Установите xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
хЧисл = 1
Пока нет (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
хЧисл = хЧисл + 1
венед
Установите xUsedRng = xSht.UsedRange
Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда
xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xStr, Качество:=xlQualityStandard
Еще

End If
xArrShetts(I) = xStr
Далее

'Создать электронную почту Outlook
Установите xOutlookObj = CreateObject("Outlook.Application")
Установите xEmailObj = xOutlookObj.CreateItem(0)
С xEmailObj
.Отображать
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Тема = "????"
Для I = 0 в UBound(xArrShetts)
On Error Resume Next
.Attachments.Add xArrShetts(I)
Далее
Если DisplayEmail = Ложь Тогда
.Послать
Exit Sub
End If
Конец с


End Sub
Ответить
0
0
Тори
Тори
Этот комментарий был сведен к минимуму модератором на сайте
Привет @кристалл
Это потрясающе - ключевая вещь, с которой я борюсь, - это имя файла - я бы хотел, чтобы имя файла вытягивалось из ячейки на листе, а не использовало имя вкладки. Я уже отредактировал код для автоматического сохранения в указанную папку, но у меня проблемы с именем файла.
Любая помощь, которую вы можете предложить, пожалуйста?
Ответить
0
0
кристалл
кристалл     Тори
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Тори. Если вы хотите назвать файл PDF с определенным значением ячейки, попробуйте следующий код. После запуска кода и выбора папки для сохранения файла появится другое диалоговое окно, выберите ячейку, которую вы будете использовать. значение в качестве имени файла PDF, а затем нажмите OK для завершения.
Подпрограмма Сохранить как PDF и отправить2 ()
'Обновлено Extendoffice 20210521
Dim xSht как рабочий лист
Dim xFileDlg как FileDialog
Dim xFolder как строка
Dim xYesorNo как целое число
Dim xOutlookObj как объект
Dim xEmailObj как объект
Dim xUsedRng, xRgInser как диапазон
Dim xB как логическое значение
Установите xSht = ActiveSheet
Установите xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Если xFileDlg.Show = True Тогда
xFolder = xFileDlg.SelectedItems(1)
Еще
MsgBox "Необходимо указать папку для сохранения PDF-файла." & vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Необходимо указать папку назначения"
Exit Sub
End If
хВ = Истина
On Error Resume Next
Пока хБ
Установить xRgInser = Ничего
Установите xRgInser = Application.InputBox («Выберите ячейку, значение которой вы будете использовать для имени файла PDF:», «Kutools for Excel», , , , , , 8)
Если xRgInser ничего, тогда
MsgBox «Ячейка не выбрана, выйдите из операции!», vbInformation, «Kutools for Excel»
Exit Sub
End If
Если xRgInser.Text = "" Тогда
MsgBox «Выбранная ячейка пуста, выберите еще раз!», vbInformation, «Kutools for Excel»
Еще
хВ = Ложь
End If
венед

xFolder = xFolder + "\" + xRgInser.Text + ".pdf"

'Проверить, существует ли уже файл
Если Лен(Каталог(xFolder)) > 0 Тогда
xYesorNo = MsgBox(xFolder & "уже существует." & vbCrLf & vbCrLf & "Хотите перезаписать?", _
vbYesNo + vbQuestion, "Файл существует")
On Error Resume Next
Если xYesилиNo = vbДа Тогда
Убить xFolder
Еще
MsgBox «Если вы не перезапишете существующий PDF-файл, я не смогу продолжить». _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Выход из макроса"
Exit Sub
End If
Если Err.Number <> 0 Тогда
MsgBox "Невозможно удалить существующий файл. Убедитесь, что файл не открыт и не защищен от записи." _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Невозможно удалить файл"
Exit Sub
End If
End If

Установите xUsedRng = xSht.UsedRange
Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда
'Сохранить как файл PDF
xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xFolder, Качество:=xlQualityStandard

'Создать электронную почту Outlook
Установите xOutlookObj = CreateObject("Outlook.Application")
Установите xEmailObj = xOutlookObj.CreateItem(0)
С xEmailObj
.Отображать
.К = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Добавить xFolder
Если DisplayEmail = Ложь Тогда
'.Отправлять
End If
Конец с
Еще
MsgBox "Активный рабочий лист не может быть пустым"
Exit Sub
End If
End Sub
Ответить
Report
0
0
Makeeuropeanu
Makeeuropeanu
Этот комментарий был сведен к минимуму модератором на сайте
Привет, мне нужно что-то подобное, вот что я получил. Он берет текущую дату и создает новую папку с именем даты в определенном месте. Он помещает PDF-файл в это новое место, а затем прикрепляет PDF-файл к новому электронному письму. Работает как лакомство. Я всего лишь новичок, поэтому, пожалуйста, извините меня, если это выглядит как беспорядок. :D
Sub PDFTOEMAIL()
Dim xSht как рабочий лист
Dim xFileDlg как FileDialog
Dim xFolder как строка
Dim xYesorNo как целое число
Dim xOutlookObj как объект
Dim xEmailObj как объект
Dim xUsedRng как диапазон
Dim xPath как строка
Dim xOutMsg как строка
Dim sFolderName как строка, sFolder как строка
Dim sFolderPath как строка

Установите xSht = ActiveSheet
xFileDate = Формат (теперь "дд-мм-гггг")
sFolder = "C:" 'здесь у вас есть основная папка
sFolderName = "Week ending" + Format(Now, "dd-mm-yyyy") 'папка, которая будет создана в основной папке с названием Week ending и текущей датой
sFolderPath = "C:" & sFolderName 'основная папка снова, чтобы создать новый путь, включая новую папку
Установите oFSO = CreateObject("Scripting.FileSystemObject")
Если oFSO.FolderExists(sFolderPath) Тогда
MsgBox "Папка уже существует!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Еще
MkDir sFolderPath
MsgBox "Новая папка создана!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
End If
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Если Лен(Каталог(xFolder)) > 0 Тогда
xYesorNo = MsgBox(xFolder & "уже существует." & vbCrLf & vbCrLf & "Хотите перезаписать?", _
vbYesNo + vbQuestion, "Файл существует")
On Error Resume Next
Если xYesилиNo = vbДа Тогда
Убить xFolder
Еще
MsgBox «Если вы не перезапишете существующий PDF-файл, я не смогу продолжить». _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Выход из макроса"
Exit Sub
End If
Если Err.Number <> 0 Тогда
MsgBox "Невозможно удалить существующий файл. Убедитесь, что файл не открыт и не защищен от записи." _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Невозможно удалить файл"
Exit Sub
End If
End If

Установите xUsedRng = xSht.UsedRange
Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда
xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xFolder, Качество:=xlQualityStandard
Установите xOutlookObj = CreateObject("Outlook.Application")
Установите xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Пожалуйста, прикрепите Это электронное письмо и вложение были сгенерированы автоматически "
'добавляет примечание о том, что электронное письмо было сгенерировано автоматически

С xEmailObj
.Отображать
.To = "" 'добавьте свои электронные письма
.CC = ""
.Subject = xSht.Name + "PDF для окончания недели" + xFileDate + "- Location" ' тема включает имя листа, pdf, дату и местоположение, это можно редактировать по мере необходимости
.Attachments.Добавить xFolder
.HTMLBody = xOutMsg и .HTMLBody
Если DisplayEmail = Ложь Тогда
'.Send <--- Здесь, если вы удалите апостроф, электронное письмо будет отправлено автоматически, поэтому будьте осторожны
End If
Конец с
Еще
MsgBox "Активный рабочий лист не может быть пустым"
Exit Sub
End If
End Sub
Ответить
Report
0
0
Николь
Николь
Этот комментарий был сведен к минимуму модератором на сайте
Как отредактировать этот код, чтобы сохранить только ячейки («a1: r99») для сохранения в формате PDF. У меня есть дополнительные материалы по бокам, которые мне не нужны в моем PDF-документе.
Подпрограмма Сохранить как PDF и отправить ()
'Обновлено Extendoffice 20210209
Dim xSht как рабочий лист
Dim xFileDlg как FileDialog
Dim xFolder как строка
Dim xYesorNo как целое число
Dim xOutlookObj как объект
Dim xEmailObj как объект
Dim xUsedRng как диапазон
Dim xStrName как строка
Размер xV как вариант

Установите xSht = ActiveSheet
Установите xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Если xFileDlg.Show = True Тогда
xFolder = xFileDlg.SelectedItems(1)
Еще
MsgBox "Необходимо указать папку для сохранения PDF-файла." & vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Необходимо указать папку назначения"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox («Пожалуйста, введите имя файла:», «Kutools for Excel», , , , , , 2)
Если xV = Ложь Тогда
Exit Sub
End If
xStrName = xV
Если xStrName = "" Тогда
MsgBox ("Имя файла не введено, выход из процесса!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Проверить, существует ли уже файл
Если Лен(Каталог(xFolder)) > 0 Тогда
xYesorNo = MsgBox(xFolder & "уже существует." & vbCrLf & vbCrLf & "Хотите перезаписать?", _
vbYesNo + vbQuestion, "Файл существует")
On Error Resume Next
Если xYesилиNo = vbДа Тогда
Убить xFolder
Еще
MsgBox «Если вы не перезапишете существующий PDF-файл, я не смогу продолжить». _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Выход из макроса"
Exit Sub
End If
Если Err.Number <> 0 Тогда
MsgBox "Невозможно удалить существующий файл. Убедитесь, что файл не открыт и не защищен от записи." _
& vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Невозможно удалить файл"
Exit Sub
End If
End If

Установите xUsedRng = xSht.UsedRange
Если Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Тогда
'Сохранить как файл PDF
xSht.ExportAsFixedFormat Тип:=xlTypePDF, Имя файла:=xFolder, Качество:=xlQualityStandard

'Создать электронную почту Outlook
Установите xOutlookObj = CreateObject("Outlook.Application")
Установите xEmailObj = xOutlookObj.CreateItem(0)
С xEmailObj
.Отображать
.К = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Добавить xFolder
Если DisplayEmail = Ложь Тогда
'.Отправлять
End If
Конец с
Еще
MsgBox "Активный рабочий лист не может быть пустым"
Exit Sub
End If
End Sub
Ответить
0
0
РЛФ
РЛФ     Николь
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, я только что попробовал этот код на одном из своих рабочих листов, и у меня установлены области печати, поэтому лишние элементы внизу не появлялись в pdf. Попробуй это!
Ответить
0
0
Род Беннетт
Род Беннетт
Этот комментарий был сведен к минимуму модератором на сайте
Hi
Большое спасибо за код, но возможно ли автоматически сохранить PDF-файл в том же месте, что и активный файл Excel, и с тем же именем файла, что и активный файл Excel?
Большое спасибо.
Стержень
Ответить
0
0
Здесь еще нет комментариев
Загрузить ещё
Оставляйте свои комментарии
GUEST
Публикация как гость
Логин
×
Оценить этот пост:
Сброс
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL