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 для додатків вікна, натисніть Insert > Модулі. Потім скопіюйте та вставте наведений нижче код 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 одночасно:

повне г, повне г,, показали, від, номер, XNUMX Роздільна робоча книга корисність Kutools для Excel може допомогти вам легко зберегти аркуш або декілька аркушів як окремі файли PDF одночасно, як показано нижче. Завантажте та спробуйте зараз! (30-денний безкоштовний маршрут)


Статті по темі:


Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

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

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Коментарі (61)
Оцінено 5 з 5 · рейтинги 1
Цей коментар був мінімізований модератором на сайті
Це чудово працює для мене, але чи є спосіб вибрати розташування папки автоматично, а не вручну? Я сподіваюся зробити це для 40 аркушів одночасно.
Цей коментар був мінімізований модератором на сайті
Також сподіваюся отримати відповідь на це питання! Дякую за допомогу!
Цей коментар був мінімізований модератором на сайті
Я спробував вставити це в новий модуль, і я отримую помилку компіляції: підпорядок або функція не визначені. Будь ласка, допоможіть.
Цей коментар був мінімізований модератором на сайті
Шановний Даррен,
Яку версію Office ви використовуєте?
Цей коментар був мінімізований модератором на сайті
управління 360
Цей коментар був мінімізований модератором на сайті
Те саме питання
Цей коментар був мінімізований модератором на сайті
Як я можу відредагувати наведений вище сценарій VBA, щоб він додав мітку дати та часу до імені файлу, щоб не перезаписувати вже збережене?
Цей коментар був мінімізований модератором на сайті
Шановний Михайло,
Будь ласка, запустіть наведений нижче код VBA, щоб вирішити проблему.

Sub Saveaspdfandsend()
Dim xSht як аркуш
Dim xFileDlg як FileDialog
Dim xFolder як рядок
Dim xYesorNo як ціле число
Затуманювати xOutlookObj як об’єкт
Змінити 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"

«Перевірте, чи вже існує файл
Якщо Len(Dir(xFolder)) > 0, то
xYesorNo = MsgBox(xFolder & " вже існує." & vbCrLf & vbCrLf & "Ви хочете перезаписати його?", _
vbYesNo + vbQuestion, "Файл існує")
On Error Resume Next
Якщо xYesorNo = vbYes Тоді
Вбийте 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"
.Вкладення.Додати xFolder
Якщо DisplayEmail = False, то
'.Надіслати
End If
Кінець з
Ще
MsgBox "Активний аркуш не може бути порожнім"
Exit Sub
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт Кристал,

Це дійсно чудово і ідеально працює для мене. Потрібна додаткова допомога, щоб додати:

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

Я буду дуже повний до вас за вашу допомогу.

Дякую
Параг
Цей коментар був мінімізований модератором на сайті
Привіт, Параг Сомані!
Наведений нижче код VBA може допомогти вам. Змініть поля .To, .CC, .BCC і .Body відповідно до ваших потреб.

Sub Saveaspdfandsend()
Dim xSht як аркуш
Dim xFileDlg як FileDialog
Dim xFolder як рядок
Dim xYesorNo як ціле число
Затуманювати xOutlookObj як об’єкт
Змінити 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"

«Перевірте, чи вже існує файл
Якщо Len(Dir(xFolder)) > 0, то
xYesorNo = MsgBox(xFolder & " вже існує." & vbCrLf & vbCrLf & "Ви хочете перезаписати його?", _
vbYesNo + vbQuestion, "Файл існує")
On Error Resume Next
Якщо xYesorNo = vbYes Тоді
Вбийте 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"
.Вкладення.Додати xFolder
Якщо DisplayEmail = False, то
'.Надіслати
End If
Кінець з
Ще
MsgBox "Активний аркуш не може бути порожнім"
Exit Sub
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Я намагався використовувати діапазон для "To", "CC", він просто не отримує значення з призначеної клітинки. Чи можете ви допомогти з цим?
Спасибі,
Мехул
Цей коментар був мінімізований модератором на сайті
Привіт Кристал,

Це дійсно чудово і ідеально працює для мене. Потрібна додаткова допомога, щоб додати:

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

Я буду дуже повний до вас за вашу допомогу.

Дякую
Параг
Цей коментар був мінімізований модератором на сайті
Привіт Кристал,

Це дійсно чудово і ідеально працює для мене. Потрібна додаткова допомога, щоб додати:

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

Я буду дуже повний до вас за вашу допомогу.

Дякую
Параг
Цей коментар був мінімізований модератором на сайті
Як я можу додати, наприклад, аркуш 2 з книги як pdf?
Цей коментар був мінімізований модератором на сайті
Привіт Армін!
Вам потрібно спочатку відкрити аркуш 2 у своїй книзі, а потім запустити код VBA з наведеними вище кроками, щоб отримати його.
Цей коментар був мінімізований модератором на сайті
Як я можу відредагувати наведений вище сценарій VBA, щоб ім’я файлу було збережено як конкретну комірку, вибрану на поточному аркуші, наприклад клітинку A1?
Цей коментар був мінімізований модератором на сайті
Привіт Том.
На жаль, не можу допомогти з цим.
Ласкаво просимо опублікувати будь-які запитання на нашому форумі: https://www.extendoffice.com/forum.html
Ви отримаєте додаткову підтримку Excel від професіоналів Excel або інших шанувальників Excel.
Цей коментар був мінімізований модератором на сайті
Привіт, як я можу зберегти та надіслати PDF-файл із назвою книги з поточним кодом VBA? що я використовую замість xSht.Name
Цей коментар був мінімізований модератором на сайті
Привіт Джеймс,
Ви хочете надіслати активний аркуш у форматі PDF і назвати його ім’ям книги?
Цей коментар був мінімізований модератором на сайті
Дякую це працює.
Цей коментар був мінімізований модератором на сайті
Як я можу змусити його видалити збережений PDF-файл після того, як він надіслав його електронною поштою?
Цей коментар був мінімізований модератором на сайті
Привіт Джейсон,
На жаль, поки що не можу вам допомогти. Після надсилання електронною поштою його потрібно видалити вручну.
Цей коментар був мінімізований модератором на сайті
Здравствуйте,

Чи можна знайти назву для pdf з комірки? Напр. Комірка H4


А в клітинці H4 я хочу, щоб він збирався з трьох різних осередків. Це можливо?
Цей коментар був мінімізований модератором на сайті
Це можливо. Створіть окремі змінні, щоб зберігати значення з комірок, а потім використовуйте ці змінні під час налаштування xFolder.
Я використав значення клітинки на своєму аркуші плюс сьогоднішню дату. Хоча ви можете легко зробити кілька значень клітинок.

Ось що я додав:
Dim xMemberName як рядок
Dim xFileDate як рядок

xMemberName = Діапазон ("H3").Значення
xFileDate = Формат (Зараз, "mm-dd")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
Цей коментар був мінімізований модератором на сайті
Я отримую помилку, коли я намагаюся це зробити, де в коді я повинен це розмістити?
Цей коментар був мінімізований модератором на сайті
Привіт Кристал,



Це дійсно чудово і ідеально працює для мене. Потрібна додаткова допомога, щоб додати:

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

Дякую

привіт

Кішоре Кумар
Цей коментар був мінімізований модератором на сайті
привіт,

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

Sub Saveaspdfandsend()

Dim xSht як аркуш

Dim xFileDlg як FileDialog

Dim xFolder як рядок

Dim xYesorNo як ціле число

Затуманювати xOutlookObj як об’єкт

Змінити 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"



«Перевірте, чи вже існує файл

Якщо Len(Dir(xFolder)) > 0, то

xYesorNo = MsgBox(xFolder & " вже існує." & vbCrLf & vbCrLf & "Ви хочете перезаписати його?", _

vbYesNo + vbQuestion, "Файл існує")

On Error Resume Next

Якщо xYesorNo = vbYes Тоді

Вбийте 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"

.Вкладення.Додати xFolder

.HTMLBody = "
" & Range("C4") & .HTMLBody

Якщо DisplayEmail = False, то

'.Надіслати

End If

Кінець з

Ще

MsgBox "Активний аркуш не може бути порожнім"

Exit Sub

End If

End Sub
Цей коментар був мінімізований модератором на сайті
Якби я хотів, щоб він щоразу автоматично зберігався в певній папці (усуваючи необхідність для користувача вибирати папку), як би я це зробив?
Напр. C: Рахунки-фактури/Північна Америка/Клієнти
Допомога дуже цінується.
Цей коментар був мінімізований модератором на сайті
Привіт Джефф!
Ви маєте на увазі зберегти робочий аркуш як файл PDF і зберегти в певній папці без надсилання?
Цей коментар був мінімізований модератором на сайті
Я думаю, що Джефф означає можливість вказати конкретну папку в коді, в яку щоразу зберігається pdf, замість того, щоб вибирати місце вручну. Потім PDF-файл надсилається електронною поштою з цієї конкретної папки.
Цей коментар був мінімізований модератором на сайті
Дякую, Джеремі.
Цей коментар був мінімізований модератором на сайті
Привіт Джефф! Якщо ви хочете автоматично зберегти файл PDF у певній папці, а не вибирати місце вручну, спробуйте наведений нижче код. Не забудьте змінити шлях до папки в коді.
Зберегти як PDF і відправити()
Dim xSht як аркуш
Dim xFileDlg як FileDialog
Dim xFolder як рядок
Dim xYesorNo як ціле число
Затуманювати xOutlookObj як об’єкт
Змінити xEmailObj як об’єкт
Dim xUsedRng як діапазон
Dim xPath як рядок
Встановіть xSht = ActiveSheet
xPath = "C:\Users\Win10x64Test\Desktop\worksheet в pdf" 'тут "з робочого листа в pdf" є папка призначення для збереження файлів pdf
xFolder = xPath + "\" + xSht.Name + ".pdf"
Якщо Len(Dir(xFolder)) > 0, то
xYesorNo = MsgBox(xFolder & " вже існує." & vbCrLf & vbCrLf & "Ви хочете перезаписати його?", _
vbYesNo + vbQuestion, "Файл існує")
On Error Resume Next
Якщо xYesorNo = vbYes Тоді
Вбийте 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"
.Вкладення.Додати xFolder
Якщо DisplayEmail = False, то
'.Надіслати
End If
Кінець з
Ще
MsgBox "Активний аркуш не може бути порожнім"
Exit Sub
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Цей код чудово працює, за винятком того, що я хочу, щоб робочий аркуш був збережений як ім’я аркуша + дата (тобто Sheet1 1 жовтня 2020 р.); на робочому столі користувача (це буде використовувати кілька людей, і їхні шляхи можуть дещо відрізнятися). Якщо можливо, я також хочу вставити .jpg в тіло. JPG знаходиться як всередині аркуша (за межами області друку), так і зображення зберігається на спільному сервері.. хоча шлях до сервера залежить від користувач (для більшості це диск "T" для деяких дисків "U")
чи можна це зробити? будь ласка і дякую вам мільйон разів.
Цей коментар був мінімізований модератором на сайті

Привіт, це чудово працює, дякую, що поділилися, потрібна лише одна допомога.
Якщо я хочу зберегти PDF-файл із налаштованим ім’ям (можливість ввести ім’я файлу в діалоговому вікні «Зберегти як»), використовуйте цей параметр у шаблоні форми, де форми зберігаються у форматі PDF з унікальною назвою.
Цей коментар був мінімізований модератором на сайті
Привіт! Будь ласка, спробуйте наведений нижче код VBA. Після запуску коду виберіть папку для збереження PDF-файлу, після чого з’явиться діалогове вікно, де потрібно ввести ім’я файлу. Sub Saveaspdfandsend()
'Оновлено Extendoffice 20210209
Dim xSht як аркуш
Dim xFileDlg як FileDialog
Dim xFolder як рядок
Dim xYesorNo як ціле число
Затуманювати xOutlookObj як об’єкт
Змінити xEmailObj як об’єкт
Dim xUsedRng як діапазон
Dim xStrName як рядок
Dim 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 для Excel", , , , , , 2)
Якщо xV = хибно, то
Exit Sub
End If
xStrName = xV
Якщо xStrName = "" Тоді
MsgBox ("Назва файлу не введено, процес завершується!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
«Перевірте, чи вже існує файл
Якщо Len(Dir(xFolder)) > 0, то
xYesorNo = MsgBox(xFolder & " вже існує." & vbCrLf & vbCrLf & "Ви хочете перезаписати його?", _
vbYesNo + vbQuestion, "Файл існує")
On Error Resume Next
Якщо xYesorNo = vbYes Тоді
Вбийте 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"
.Вкладення.Додати xFolder
Якщо DisplayEmail = False, то
'.Надіслати
End If
Кінець з
Ще
MsgBox "Активний аркуш не може бути порожнім"
Exit Sub
End If
End Sub
Цей коментар був мінімізований модератором на сайті
привіт,
Якщо у мене є два аркуші у файлі, і я хотів би запустити цей макрос на одному аркуші (натиснувши кнопку), але надіслати інший, як я можу його отримати?
Цей коментар був мінімізований модератором на сайті
Привіт, я хотів би зберегти це в певному місці файлу з назвою на основі значення в комірці C30. Я спробував кілька варіантів, але постійно отримував помилки.
Цей коментар був мінімізований модератором на сайті
Привіт, Hein, наведений нижче код може допомогти. Після запуску коду виберіть певну папку для збереження PDF-файлу, після чого з’явиться діалогове вікно, де потрібно ввести ім’я файлу. Sub Saveaspdfandsend()
'Оновлено Extendoffice 20210209
Dim xSht як аркуш
Dim xFileDlg як FileDialog
Dim xFolder як рядок
Dim xYesorNo як ціле число
Затуманювати xOutlookObj як об’єкт
Змінити xEmailObj як об’єкт
Dim xUsedRng як діапазон
Dim xStrName як рядок
Dim 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 для Excel", , , , , , 2)
Якщо xV = хибно, то
Exit Sub
End If
xStrName = xV
Якщо xStrName = "" Тоді
MsgBox ("Назва файлу не введено, процес завершується!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
«Перевірте, чи вже існує файл
Якщо Len(Dir(xFolder)) > 0, то
xYesorNo = MsgBox(xFolder & " вже існує." & vbCrLf & vbCrLf & "Ви хочете перезаписати його?", _
vbYesNo + vbQuestion, "Файл існує")
On Error Resume Next
Якщо xYesorNo = vbYes Тоді
Вбийте 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"
.Вкладення.Додати xFolder
Якщо DisplayEmail = False, то
'.Надіслати
End If
Кінець з
Ще
MsgBox "Активний аркуш не може бути порожнім"
Exit Sub
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Дякую за це, це чудово, але я хочу, щоб аркуш мав назву відповідно до клітинки A1 на аркуші 1. Місце для збереження відповідно до A1 на аркуші 2, наприклад C:\Users\peete\Dropbox\Screenshots, і надіслати електронну пошту на адреса електронної пошти на аркуші А3 2, що я вже розробив.
Цей коментар був мінімізований модератором на сайті
Дякую за це, це чудово, але я хочу, щоб аркуш мав назву відповідно до комірки A1 на аркуші 1. Місце для збереження відповідно до A1 на аркуші 2, наприклад C:\Users\peete\Dropbox\Screenshots, але може змінитися, коли за допомогою файлу та надіслати електронною поштою на адресу електронної пошти на аркуші А3 2 те, що я вже розробив.
Цей коментар був мінімізований модератором на сайті
Hi кристал , чудовий код, дякую за обмін. Чи є спосіб вибрати кілька аркушів (з однієї книги), щоб зберегти кожен як незалежний PDF-файл, а потім надіслати їх усі вкладені в одному електронному листі?
Цей коментар був мінімізований модератором на сайті
Привіт! Наведений нижче код VBA може зробити вам послугу, будь ласка, спробуйте. У дванадцятому рядку коду замініть назви аркушів справжніми іменами аркушів у вашому випадку.
Sub Saveaspdfandsend1()
Dim xSht як аркуш
Dim xFileDlg як FileDialog
Dim xFolder як рядок
Dim xYesorNo, I, xNum як ціле число
Затуманювати xOutlookObj як об’єкт
Змінити 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 для 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"
xNum = 1
Хоча ні (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 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 = ""
.Subject = "????"
Для I = 0 до UBound(xArrShetts)
.Додатки.Додати xArrShetts(I)
Далі
Якщо DisplayEmail = False, то
'.Надіслати
End If
Кінець з
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт! Єдина зміна, з якою я борюся, - це створити окрему електронну пошту для кожного створеного PDF-документа.
Цей коментар був мінімізований модератором на сайті
Привіт! Щоб створити окрему електронну пошту для кожного документа PDF, ви можете вручну запустити VBA, надану в публікації, на різних робочих аркушах, щоб це зробити.
Цей коментар був мінімізований модератором на сайті
У мене є понад 100 аркушів у книзі, що призведе до того, що мені доведеться запускати VBA більше 100 разів, що займає багато часу.  
Мені вдалося розділити мою книгу на кілька аркушів, а потім я можу перетворити кожен аркуш в окремий документ PDF.
Рішення, яке я шукаю, — надсилати електронною поштою кожен PDF-документ окремо, поки виконується зазначений вище процес.
Ось VBA, який я зараз використовую:
Sub Saveaspdfandsend1()
Dim xSht як аркуш
Dim xFileDlg як FileDialog
Dim xFolder як рядок
Dim xYesorNo, I, xNum як ціле число
Затуманювати xOutlookObj як об’єкт
Змінити xEmailObj як об’єкт
Dim xUsedRng як діапазон
Dim xArrShetts як варіант
Dim xPDFNameAddress як рядок
Dim xStr як рядок
xArrShetts = Масив("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 для 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"
xNum = 1
Хоча ні (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 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 = ""
.Subject = "????"
Для I = 0 до UBound(xArrShetts)
On Error Resume Next
.Додатки.Додати xArrShetts(I)
Далі
Якщо DisplayEmail = False, то
.Надіслати
Exit Sub
End If
Кінець з


End Sub
Цей коментар був мінімізований модератором на сайті
Привіт @crystal
Це неймовірно — головне, з чим я борюся, — це ім’я файлу — я хотів би, щоб ім’я файлу витягало з комірки на аркуші, а не використовувало ім’я вкладки. Я вже відредагував код, щоб автоматично зберігати його у вказаній папці, але я борюся з назвою файлу.
Будь ласка, будь ласка, будь-яку допомогу?
Цей коментар був мінімізований модератором на сайті
Привіт Торі! Якщо ви хочете назвати PDF-файл із певним значенням комірки, спробуйте наступний код. Після запуску коду та вибору папки для збереження файлу з’явиться інше діалогове вікно, будь ласка, виберіть клітинку, яку ви будете використовувати значення як ім’я файлу PDF, а потім натисніть кнопку OK, щоб завершити.
Sub Saveaspdfandsend2()
'Оновлено Extendoffice 20210521
Dim xSht як аркуш
Dim xFileDlg як FileDialog
Dim xFolder як рядок
Dim xYesorNo як ціле число
Затуманювати xOutlookObj як об’єкт
Змінити 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
xB = правда
On Error Resume Next
У той час як xB
Встановіть xRgInser = Нічого
Встановіть xRgInser = Application.InputBox("Виберіть клітинку, значення якої використовуватиметься для назви файлу PDF:", "Kutools для Excel", , , , , , 8)
Якщо xRgInser - це нічого, то
MsgBox " Жодну клітинку не виділено, вийдіть з операції!", vbInformation, "Kutools для Excel"
Exit Sub
End If
Якщо xRgInser.Text = "" Тоді
MsgBox "Вибрана клітинка порожня, будь ласка, виберіть ще раз!", vbInformation, "Kutools для Excel"
Ще
xB = Неправда
End If
Венед

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

«Перевірте, чи вже існує файл
Якщо Len(Dir(xFolder)) > 0, то
xYesorNo = MsgBox(xFolder & " вже існує." & vbCrLf & vbCrLf & "Ви хочете перезаписати його?", _
vbYesNo + vbQuestion, "Файл існує")
On Error Resume Next
Якщо xYesorNo = vbYes Тоді
Вбийте 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"
.Вкладення.Додати xFolder
Якщо DisplayEmail = False, то
'.Надіслати
End If
Кінець з
Ще
MsgBox "Активний аркуш не може бути порожнім"
Exit Sub
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт, мені знадобилося щось подібне, тож ось що я отримав. Він бере поточну дату та створює нову папку з назвою дати в певному місці. Він розміщує PDF-файл у цьому новому місці, а потім вкладає PDF-файл до нового електронного листа. Працює як ласощі. Я лише новачок, тому, будь ласка, вибачте, якщо це виглядає як безлад. :D
Sub PDFTOEMAIL()
Dim xSht як аркуш
Dim xFileDlg як FileDialog
Dim xFolder як рядок
Dim xYesorNo як ціле число
Затуманювати xOutlookObj як об’єкт
Змінити xEmailObj як об’єкт
Dim xUsedRng як діапазон
Dim xPath як рядок
Dim xOutMsg як рядок
Dim sFolderName як рядок, sFolder як рядок
Dim sFolderPath як рядок

Встановіть xSht = ActiveSheet
xFileDate = Формат (Зараз, "дд-мм-рррр")
sFolder = "C:" 'тут у вас є основна папка
sFolderName = "Закінчення тижня " + Формат(Зараз, "дд-мм-рррр") 'папка, яка буде створена в головній папці з назвою закінчення тижня та поточною датою
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"
Якщо Len(Dir(xFolder)) > 0, то
xYesorNo = MsgBox(xFolder & " вже існує." & vbCrLf & vbCrLf & "Ви хочете перезаписати його?", _
vbYesNo + vbQuestion, "Файл існує")
On Error Resume Next
Якщо xYesorNo = vbYes Тоді
Вбийте 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, дату та місце розташування, це можна відредагувати за потреби
.Вкладення.Додати xFolder
.HTMLBody = xOutMsg & .HTMLBody
Якщо DisplayEmail = False, то
'.Надіслати <--- Тут, якщо ви видалите апостроф, електронний лист буде надіслано автоматично, тому будьте обережні
End If
Кінець з
Ще
MsgBox "Активний аркуш не може бути порожнім"
Exit Sub
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Як відредагувати цей код, щоб зберегти клітинки ("a1:r99"), щоб зберегти їх у форматі PDF. У мене є зайві речі на сторонах, які я не хочу в моєму PDF-документі.
Sub Saveaspdfandsend()
'Оновлено Extendoffice 20210209
Dim xSht як аркуш
Dim xFileDlg як FileDialog
Dim xFolder як рядок
Dim xYesorNo як ціле число
Затуманювати xOutlookObj як об’єкт
Змінити xEmailObj як об’єкт
Dim xUsedRng як діапазон
Dim xStrName як рядок
Dim 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 для Excel", , , , , , 2)
Якщо xV = хибно, то
Exit Sub
End If
xStrName = xV
Якщо xStrName = "" Тоді
MsgBox ("Назва файлу не введено, процес завершується!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
«Перевірте, чи вже існує файл
Якщо Len(Dir(xFolder)) > 0, то
xYesorNo = MsgBox(xFolder & " вже існує." & vbCrLf & vbCrLf & "Ви хочете перезаписати його?", _
vbYesNo + vbQuestion, "Файл існує")
On Error Resume Next
Якщо xYesorNo = vbYes Тоді
Вбийте 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"
.Вкладення.Додати xFolder
Якщо DisplayEmail = False, то
'.Надіслати
End If
Кінець з
Ще
MsgBox "Активний аркуш не може бути порожнім"
Exit Sub
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт, я щойно спробував цей код на одному зі своїх робочих аркушів, і в мене налаштовано області друку, тому зайвий матеріал унизу не з’являвся в pdf. Спробуй це!
Цей коментар був мінімізований модератором на сайті
Hi
Велике спасибі за код, але чи можна автоматично зберегти PDF-файл у тому самому місці, що й активний файл Excel, і з тим же ім’ям файлу, що й активний файл Excel?
Велике спасибі.
стрижень
There are no comments posted here yet
Load More
Залишайте свої коментарі
Публікація як гість
×
Оцініть цю публікацію:
0   Персонажі
Рекомендовані місця