如何将工作表另存为PDF文件并将其作为附件通过Outlook通过电子邮件发送？

在某些情况下，您可能需要通过Outlook将工作表作为PDF文件发送。通常，您必须手动将工作表另存为PDF文件，然后在Outlook中使用带有该PDF文件作为附件的新电子邮件来发送。一步一步地手动实现它很耗时。在本文中，我们将向您展示如何快速将工作表另存为PDF文件并自动将其作为附件通过Excel中的Outlook发送。

将工作表另存为PDF文件并通过VBA代码作为附件通过电子邮件发送

将工作表另存为PDF文件并通过VBA代码作为附件通过电子邮件发送

惊人的！在 Excel 中使用高效的选项卡，如 Chrome、Firefox 和 Safari！

每天节省50％的时间，并减少数千次鼠标单击！

您可以运行下面的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作为邮件程序时，此代码才可用。

新的 拆分工作簿 实用程序 Kutools for Excel 可以帮助您轻松地一次将一个工作表或多个工作表另存为单独的PDF文件，如下面的演示所示。 立即下载并试用！ (30-天自由行)

最佳办公效率工具

Kutools for Excel解决了您的大多数问题，并使您的生产率提高了80％

重用: 快速插入 复杂的公式，图表 以及您以前使用过的任何东西；加密单元带密码创建邮件列表并发送电子邮件...
超级公式栏（轻松编辑多行文本和公式）；阅读版式（轻松读取和编辑大量单元格）；粘贴到过滤范围...
合并单元格/行/列不会丢失数据；拆分单元格内容；合并重复的行/列...防止细胞重复；比较范围...
选择重复或唯一行; 选择空白行（所有单元格都是空的）；超级查找和模糊查找在许多工作簿中；随机选择...
确切的副本多个单元格，无需更改公式参考；自动创建参考到多张纸；插入项目符号，复选框等...
提取文字，添加文本，按位置删除，删除空间; 创建和打印分页小计；在单元格内容和注释之间转换...
超级滤镜（将过滤方案保存并应用于其他工作表）；高级排序按月/周/日，频率及更多；特殊过滤器用粗体，斜体...
结合工作簿和工作表; 根据关键列合并表；将数据分割成多个工作表; 批量转换xls，xlsx和PDF...
超过300种强大功能. 支持 Office / Excel 2007-2021 和 365。支持所有语言。在您的企业或组织中轻松部署。完整功能 30 天免费试用。 60 天退款保证。

阅读更多免费下载... 采购...

Office选项卡为Office带来了选项卡式界面，使您的工作更加轻松

在Word，Excel，PowerPoint中启用选项卡式编辑和阅读，发布者，Access，Visio和Project。
在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。
每天将您的工作效率提高50％，并减少数百次鼠标单击！

阅读更多免费下载... 采购...

注释 (63)

5中的5评分 · 1评级

Michael （中国）

大约5年前

#20277

该评论由网站上的主持人最小化

这对我来说非常有用，但是有没有办法自动选择文件夹位置而不是手动选择？我希望一次做 40 张。

休 Michael （中国）

大约2年前

#20278

该评论由网站上的主持人最小化

也希望看到这个问题的答案！谢谢您的帮助！

达伦

大约5年前

#22279

该评论由网站上的主持人最小化

我尝试将其粘贴到新模块中，但出现编译错误：未定义子或函数。请帮忙。

水晶达伦

大约5年前

#22280

该评论由网站上的主持人最小化

亲爱的达伦，
您使用哪个 Office 版本？

报告

纳基亚水晶

大约4年前

#22281

该评论由网站上的主持人最小化

办公室360

法案达伦

大约4年前

#22282

该评论由网站上的主持人最小化

同样的问题

迈克尔·查里

大约4年前

#24346

该评论由网站上的主持人最小化

我将如何编辑上面的 VBA 脚本，以便它在文件名中添加日期和时间戳，这样它就不会继续覆盖已保存的内容？

报告

水晶迈克尔·查里

大约4年前

#24347

该评论由网站上的主持人最小化

亲爱的迈克尔，
请运行以下 VBA 代码来解决问题。

子另存为pdfandsend()
将 xSht 调暗为工作表
将 xFileDlg 调暗为 FileDialog
将 xFolder 调暗为字符串
将 xYesorNo 调暗为整数
将 xOutlookObj 调暗为对象
将 xEmailObj 调暗为对象
将 xUsedRng 调暗为范围
将 xStr 调暗为字符串

设置 xSht = ActiveSheet
设置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那么
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必须指定一个文件夹来保存 PDF。" & vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "必须指定目标文件夹"
退出小组
结束如果
xStr = 格式（现在（），“yyyy-mm-dd-hh-mm-ss”）
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'检查文件是否已经存在
如果 Len(Dir(xFolder)) > 0 那么
xYesorNo = MsgBox(xFolder & " 已经存在。" & vbCrLf & vbCrLf & "你想覆盖它吗？", _
vbYesNo + vbQuestion, "文件存在")
出错时继续下一步
如果 xYesorNo = vbYes 那么
杀死 xFolder
其他
MsgBox "如果您不覆盖现有的 PDF，我将无法继续。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小组
结束如果
如果 Err.Number <> 0 则
MsgBox "无法删除现有文件。请确保文件未打开或未写保护。" _
& vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "无法删除文件"
退出小组
结束如果
结束如果

设置 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 = ""
.CC =“”
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Attachments.Add x文件夹
如果 DisplayEmail = False 那么
'。发送
结束如果
结束
其他
MsgBox "活动工作表不能为空"
退出小组
结束如果
END SUB

报告

帕拉格·索马尼水晶

大约3年前

#24348

该评论由网站上的主持人最小化

嗨水晶，

这真的很棒，对我来说非常完美。需要更多帮助来添加：

1. 在“收件人”中，我想在 CC 和 BCC 中提供指向活动工作表特定单元格的链接，我想添加活动工作表链接
2. 在电子邮件正文中我需要指定一些标准文本。

我会很高兴为您提供帮助。

谢谢
帕拉格

水晶帕拉格·索马尼

大约3年前

#24349

该评论由网站上的主持人最小化

嗨，帕拉格·索马尼，
下面的 VBA 代码可以帮助你。请根据您的需要更改 .To、.CC、.BCC 和 .Body 字段。

子另存为pdfandsend()
将 xSht 调暗为工作表
将 xFileDlg 调暗为 FileDialog
将 xFolder 调暗为字符串
将 xYesorNo 调暗为整数
将 xOutlookObj 调暗为对象
将 xEmailObj 调暗为对象
将 xUsedRng 调暗为范围
将 xStr 调暗为字符串

设置 xSht = ActiveSheet
设置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那么
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必须指定一个文件夹来保存 PDF。" & vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "必须指定目标文件夹"
退出小组
结束如果
xStr = 格式（现在（），“yyyy-mm-dd-hh-mm-ss”）
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'检查文件是否已经存在
如果 Len(Dir(xFolder)) > 0 那么
xYesorNo = MsgBox(xFolder & " 已经存在。" & vbCrLf & vbCrLf & "你想覆盖它吗？", _
vbYesNo + vbQuestion, "文件存在")
出错时继续下一步
如果 xYesorNo = vbYes 那么
杀死 xFolder
其他
MsgBox "如果您不覆盖现有的 PDF，我将无法继续。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小组
结束如果
如果 Err.Number <> 0 则
MsgBox "无法删除现有文件。请确保文件未打开或未写保护。" _
& vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "无法删除文件"
退出小组
结束如果
结束如果

设置 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 = Range("A8")
.CC = 范围（“A9”）
.BCC = 范围（“A10”）
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Body =“亲爱的”_
& vbNewLine & vbNewLine & _
“这是一封测试邮件” & _
“在 Excel 中发送”
.Attachments.Add x文件夹
如果 DisplayEmail = False 那么
'。发送
结束如果
结束
其他
MsgBox "活动工作表不能为空"
退出小组
结束如果
END SUB

报告

MEHUL 水晶

大约10个月前

#24350

该评论由网站上的主持人最小化

我一直在尝试将 Range 用于“To”、“CC”，它只是没有从指定的单元格中获取值。你能帮忙吗？
谢谢，
MEHUL

帕拉格·索马尼水晶

大约3年前

#24351

该评论由网站上的主持人最小化

帕拉格水晶

大约3年前

#24352

该评论由网站上的主持人最小化

报告

阿明

大约4年前

#24839

该评论由网站上的主持人最小化

例如，如何将工作簿中的工作表 2 添加为 pdf？

水晶阿明

大约4年前

#24840

该评论由网站上的主持人最小化

嗨，阿明，
您需要先在工作簿中打开工作表 2，然后按照上述步骤运行 VBA 代码以将其下载下来。

报告

汤姆·H

大约4年前

#25005

该评论由网站上的主持人最小化

我将如何编辑上面的 VBA 脚本，以便将文件名保存为在当前工作表中选择的特定单元格，例如单元格 A1？

水晶汤姆·H

大约4年前

#25006

该评论由网站上的主持人最小化

你好汤姆。
抱歉帮不上忙。
欢迎在我们的论坛发表任何问题： https://www.extendoffice.com/forum.html
您将从 Excel 专业人士或其他 Excel 爱好者那里获得更多 Excel 支持。

报告

詹姆斯

大约4年前

#26183

该评论由网站上的主持人最小化

嗨，我如何使用当前的 VBA 代码保存并发送带有工作簿名称的 pdf？我用什么代替 xSht.Name

水晶詹姆斯

大约4年前

#26184

该评论由网站上的主持人最小化

嗨詹姆斯，
您想以 pdf 格式发送活动工作表并将其命名为工作簿名称吗？

报告

朗高

大约3年前

#29450

该评论由网站上的主持人最小化

谢谢它的工作原理。

杰森

大约3年前

#29502

该评论由网站上的主持人最小化

我怎样才能让它在它通过电子邮件发送后删除保存的pdf？

水晶杰森

大约3年前

#29503

该评论由网站上的主持人最小化

嗨，杰森，
抱歉还不能帮你。您需要在通过电子邮件发送后手动删除它。

报告

奇数

大约3年前

#30839

该评论由网站上的主持人最小化

你好，

是否可以从单元格中找到 pdf 的名称？前任。单元格 H4

在单元格 H4 中，我希望它从三个不同的单元格中收集。这可能吗？

泰勒奇数

大约2年前

#30840

该评论由网站上的主持人最小化

这个有可能。创建单独的变量以保存单元格中的值，然后在设置 xFolder 时使用这些变量。
我使用了工作表中单元格中的值加上今天的日期。不过，您可以轻松地执行多个单元格值。

这是我添加的：
将 xMemberName 调暗为字符串
将 xFileDate 调暗为字符串

xMemberName = Range("H3").Value
xFileDate = 格式（现在，“mm-dd”）

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"

空泰勒

大约4个月前

#40196

该评论由网站上的主持人最小化

尝试此操作时出现错误，我应该将其放置在代码的哪个位置？

基肖尔

大约2年前

#32506

该评论由网站上的主持人最小化

嗨水晶，

这真的很棒，对我来说非常完美。需要更多帮助来添加：

1.在“正文”中，我想给出活动表的特定单元格的链接。进一步想加粗文本。

谢谢

问候

Kishore库马尔

报告

水晶基肖尔

大约2年前

#32507

该评论由网站上的主持人最小化

嗨，

您的意思是自动将单元格值添加到邮件正文并加粗吗？假设您将 C4 的值添加到邮件正文。请应用以下代码。

子另存为pdfandsend()

将 xSht 调暗为工作表

将 xFileDlg 调暗为 FileDialog

将 xFolder 调暗为字符串

将 xYesorNo 调暗为整数

将 xOutlookObj 调暗为对象

将 xEmailObj 调暗为对象

将 xUsedRng 调暗为范围

设置 xSht = ActiveSheet

设置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那么

xFolder = xFileDlg.SelectedItems(1)

其他

MsgBox "您必须指定一个文件夹来保存 PDF。" & vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "必须指定目标文件夹"

退出小组

结束如果

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

'检查文件是否已经存在

如果 Len(Dir(xFolder)) > 0 那么

xYesorNo = MsgBox(xFolder & " 已经存在。" & vbCrLf & vbCrLf & "你想覆盖它吗？", _

vbYesNo + vbQuestion, "文件存在")

出错时继续下一步

如果 xYesorNo = vbYes 那么

杀死 xFolder

其他

MsgBox "如果您不覆盖现有的 PDF，我将无法继续。" _

& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"

退出小组

结束如果

如果 Err.Number <> 0 则

MsgBox "无法删除现有文件。请确保文件未打开或未写保护。" _

& vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "无法删除文件"

退出小组

结束如果

结束如果

设置 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 = ""

.CC =“”

.Subject = xSht.Name + ".pdf"

.Attachments.Add x文件夹

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

如果 DisplayEmail = False 那么

'。发送

结束如果

结束

其他

MsgBox "活动工作表不能为空"

退出小组

结束如果

END SUB

报告

杰夫

大约2年前

#33679

该评论由网站上的主持人最小化

如果我希望它每次都自动保存在特定文件夹中（消除用户选择文件夹的需要），我该怎么做？
前任。 C：发票/北美/客户
非常感谢帮助。

水晶杰夫

大约2年前

#33680

该评论由网站上的主持人最小化

嗨，杰夫，
您的意思是将工作表另存为 pdf 文件并保存到特定文件夹而不发送？

报告

杰里米水晶

大约2年前

#33681

该评论由网站上的主持人最小化

我认为 Geoff 意味着能够在每次保存 pdf 的代码中指定特定文件夹，而不必手动选择位置。然后从该特定文件夹通过电子邮件发送 pdf。

水晶杰里米

大约2年前

#33682

该评论由网站上的主持人最小化

谢谢杰里米。

报告

水晶杰夫

大约2年前

#33683

该评论由网站上的主持人最小化

嗨 Geoff，如果您想自动将 pdf 文件保存到特定文件夹而不是手动选择位置，请尝试以下代码。不要忘记更改代码中的文件夹路径。
子 SaveAsPDFandSend()
将 xSht 调暗为工作表
将 xFileDlg 调暗为 FileDialog
将 xFolder 调暗为字符串
将 xYesorNo 调暗为整数
将 xOutlookObj 调暗为对象
将 xEmailObj 调暗为对象
将 xUsedRng 调暗为范围
将 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, "文件存在")
出错时继续下一步
如果 xYesorNo = vbYes 那么
杀死 xFolder
其他
MsgBox "如果您不覆盖现有的 PDF，我将无法继续。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小组
结束如果
如果 Err.Number <> 0 则
MsgBox "无法删除现有文件。请确保文件未打开或未写保护。" _
& vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "无法删除文件"
退出小组
结束如果
结束如果

设置 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 = ""
.CC =“”
.Subject = xSht.Name + ".pdf"
.Attachments.Add x文件夹
如果 DisplayEmail = False 那么
'。发送
结束如果
结束
其他
MsgBox "活动工作表不能为空"
退出小组
结束如果
END SUB

报告

艾莉森

大约2年前

#34153

该评论由网站上的主持人最小化

此代码效果很好，除了我想将工作表另存为工作表名称 + 日期（即 Sheet1 Oct 1 2020）；在用户的桌面上（这将被多人使用，他们的路径可能略有不同）。如果可能的话，我也想将 .jpg 嵌入到正文中.. JPG 位于工作表内部（打印区域之外），并且图像存储在共享服务器上.. 虽然服务器的路径因用户（对于某些“U”驱动器来说，它是“T”驱动器）
可以这样做吗？请并感谢你一百万次。

迪帕克

大约2年前

#34748

该评论由网站上的主持人最小化

嗨，它工作得很好，谢谢你的分享，只需要一个帮助。
如果我想保存具有自定义名称的 PDF 文件（在 SaveAs 对话框中键入文件名的选项），因为用户在表单模板中使用此选项，其中表单保存为具有唯一名称的 PDF。

报告

水晶迪帕克

大约 1 年前

#34749

该评论由网站上的主持人最小化

嗨，请尝试下面的 VBA 代码。运行代码后，选择一个文件夹来保存PDF文件，然后会弹出一个对话框让您输入文件名。 Sub Saveaspdfandsend()
'更新者 Extendoffice 20210209
将 xSht 调暗为工作表
将 xFileDlg 调暗为 FileDialog
将 xFolder 调暗为字符串
将 xYesorNo 调暗为整数
将 xOutlookObj 调暗为对象
将 xEmailObj 调暗为对象
将 xUsedRng 调暗为范围
将 xStrName 调暗为字符串
将 xV 变暗为变体

设置 xSht = ActiveSheet
设置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那么
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必须指定一个文件夹来保存 PDF。" & vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "必须指定目标文件夹"
退出小组
结束如果
xStrName = ""
xV = Application.InputBox("请输入文件名:", "Kutools for Excel", , , , , , 2)
如果 xV = False 那么
退出小组
结束如果
xStrName = xV
如果 xStrName = "" 那么
MsgBox ("没有输入文件名，正在退出进程！")
退出小组
结束如果

xFolder = xFolder + "\" + xStrName + ".pdf"
'检查文件是否已经存在
如果 Len(Dir(xFolder)) > 0 那么
xYesorNo = MsgBox(xFolder & " 已经存在。" & vbCrLf & vbCrLf & "你想覆盖它吗？", _
vbYesNo + vbQuestion, "文件存在")
出错时继续下一步
如果 xYesorNo = vbYes 那么
杀死 xFolder
其他
MsgBox "如果您不覆盖现有的 PDF，我将无法继续。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小组
结束如果
如果 Err.Number <> 0 则
MsgBox "无法删除现有文件。请确保文件未打开或未写保护。" _
& vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "无法删除文件"
退出小组
结束如果
结束如果

设置 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 = ""
.CC =“”
.Subject = xSht.Name + ".pdf"
.Attachments.Add x文件夹
如果 DisplayEmail = False 那么
'。发送
结束如果
结束
其他
MsgBox "活动工作表不能为空"
退出小组
结束如果
END SUB

报告

Mleczus94

大约 1 年前

#35017

该评论由网站上的主持人最小化

嗨，
如果我在文件中有两张纸，我想在一张纸上运行这个宏（通过按下按钮）但发送另一张，我怎样才能得到它？

报告

海因

大约 1 年前

#35061

该评论由网站上的主持人最小化

您好，我想将其保存在某个文件位置，名称基于单元格 C30 中的值。我尝试了一些选项，但不断出现故障。

水晶海因

大约 1 年前

#35062

该评论由网站上的主持人最小化

嗨，hein，下面的代码可能会有所帮助。运行代码后，选择某个文件夹保存PDF文件，然后会弹出一个对话框让您输入文件名。 Sub Saveaspdfandsend()
'更新者 Extendoffice 20210209
将 xSht 调暗为工作表
将 xFileDlg 调暗为 FileDialog
将 xFolder 调暗为字符串
将 xYesorNo 调暗为整数
将 xOutlookObj 调暗为对象
将 xEmailObj 调暗为对象
将 xUsedRng 调暗为范围
将 xStrName 调暗为字符串
将 xV 变暗为变体

设置 xSht = ActiveSheet
设置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那么
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必须指定一个文件夹来保存 PDF。" & vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "必须指定目标文件夹"
退出小组
结束如果
xStrName = ""
xV = Application.InputBox("请输入文件名:", "Kutools for Excel", , , , , , 2)
如果 xV = False 那么
退出小组
结束如果
xStrName = xV
如果 xStrName = "" 那么
MsgBox ("没有输入文件名，正在退出进程！")
退出小组
结束如果

xFolder = xFolder + "\" + xStrName + ".pdf"
'检查文件是否已经存在
如果 Len(Dir(xFolder)) > 0 那么
xYesorNo = MsgBox(xFolder & " 已经存在。" & vbCrLf & vbCrLf & "你想覆盖它吗？", _
vbYesNo + vbQuestion, "文件存在")
出错时继续下一步
如果 xYesorNo = vbYes 那么
杀死 xFolder
其他
MsgBox "如果您不覆盖现有的 PDF，我将无法继续。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小组
结束如果
如果 Err.Number <> 0 则
MsgBox "无法删除现有文件。请确保文件未打开或未写保护。" _
& vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "无法删除文件"
退出小组
结束如果
结束如果

设置 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 = ""
.CC =“”
.Subject = xSht.Name + ".pdf"
.Attachments.Add x文件夹
如果 DisplayEmail = False 那么
'。发送
结束如果
结束
其他
MsgBox "活动工作表不能为空"
退出小组
结束如果
END SUB

报告

海恩水晶

大约 1 年前

#35063

该评论由网站上的主持人最小化

谢谢你，太好了，但我希望工作表按照工作表 1 上的单元格 A1 命名。按照工作表 1 上的 A2 保存的位置，例如 C:\Users\peete\Dropbox\Screenshots，并通过电子邮件发送到A3 表 2 上的电子邮件地址我已经制定了。

海因彼特水晶

大约 1 年前

#35064

该评论由网站上的主持人最小化

谢谢你，那太好了，但我希望工作表按照工作表 1 上的单元格 A1 命名。按照工作表 1 上的 A2 保存的位置，例如 C:\Users\peete\Dropbox\Screenshots，但可以更改时间使用该文件，并将电子邮件发送到 A3 表 2 上的电子邮件地址，这是我已经制定的。

报告

本斯波

大约 1 年前

#35283

该评论由网站上的主持人最小化

Hi 水晶，优秀的代码感谢分享。有没有办法选择多张工作表（来自同一个工作簿）以将每一张保存为独立的 PDF，然后将它们全部发送到一封电子邮件中？

报告

水晶本斯波

大约 1 年前

#35284

该评论由网站上的主持人最小化

您好，下面的 VBA 代码可以帮到您，请试一试。在代码的第 XNUMX 行，请将工作表名称替换为您的实际工作表名称。
Sub Saveaspdfandsend1()
将 xSht 调暗为工作表
将 xFileDlg 调暗为 FileDialog
将 xFolder 调暗为字符串
将 xYesorNo, I, xNum 调暗为整数
将 xOutlookObj 调暗为对象
将 xEmailObj 调暗为对象
将 xUsedRng 调暗为范围
将 xArrShetts 调暗为变体
将 xPDFNameAddress 调暗为字符串
将 xStr 调暗为字符串
xArrShetts = 数组（“测试”, “表 1”, “表 2”) '输入您将作为 pdf 文件发送的工作表名称，并用引号括起来并用逗号分隔。确保文件名中没有特殊字符，例如 \/:"*<>|。

对于 I = 0 到 UBound(xArrShetts)
出错时继续下一步
设置 xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
如果 xSht.Name <> xArrShetts(I) 那么
MsgBox "未找到工作表，退出操作：" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
退出小组
结束如果
下一页

设置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFileDlg.Show = True 那么
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必须指定一个文件夹来保存 PDF。" & vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "必须指定目标文件夹"
退出小组
结束如果
'检查文件是否已经存在
xYesorNo = MsgBox("如果目标文件夹中存在同名文件，则会在文件名中自动添加数字后缀以区分重复" & vbCrLf & vbCrLf & "单击是继续，单击否取消", _
vbYesNo + vbQuestion, "文件存在")
If xYesorNo <> vbYes Then Exit Sub
对于 I = 0 到 UBound(xArrShetts)
设置 xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
x数 = 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
其他

结束如果
xArrShetts(I) = xStr
下一页

'创建 Outlook 电子邮件
设置 xOutlookObj = CreateObject("Outlook.Application")
设置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。显示
.To = ""
.CC =“”
.Subject = "????"
对于 I = 0 到 UBound(xArrShetts)
.Attachments.Add xArrShetts(一)
下一页
如果 DisplayEmail = False 那么
'。发送
结束如果
结束
END SUB

报告

伯尼·鲁道夫水晶

大约 1 年前

#35285

该评论由网站上的主持人最小化

嗨，我正在努力解决的一个变化是为每个创建的 pdf 文档创建一个单独的电子邮件。

水晶伯尼·鲁道夫

大约 1 年前

#35286

该评论由网站上的主持人最小化

嗨，要为每个 pdf 文档创建单独的电子邮件，您可以在不同的工作表中手动运行帖子中提供的 VBA 来完成它。

报告

伯尼·鲁道夫水晶

大约 1 年前

#35287

该评论由网站上的主持人最小化

我的工作簿中有 100 多个工作表，这意味着我必须运行 VBA 超过 100 次，这很耗时。
我设法将我的工作簿拆分为多个工作表，然后我能够将每个工作表转换为一个单独的 PDF 文档。
我正在寻找的解决方案是在上述过程运行时分别通过电子邮件发送每个 PDF 文档。
我目前正在运行的 VBA：
子另存为pdfandsend1()
将 xSht 调暗为工作表
将 xFileDlg 调暗为 FileDialog
将 xFolder 调暗为字符串
将 xYesorNo, I, xNum 调暗为整数
将 xOutlookObj 调暗为对象
将 xEmailObj 调暗为对象
将 xUsedRng 调暗为范围
将 xArrShetts 调暗为变体
将 xPDFNameAddress 调暗为字符串
将 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)
出错时继续下一步
设置 xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
如果 xSht.Name <> xArrShetts(I) 那么
MsgBox "未找到工作表，退出操作：" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
退出小组
结束如果
下一页

设置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFileDlg.Show = True 那么
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必须指定一个文件夹来保存 PDF。" & vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "必须指定目标文件夹"
退出小组
结束如果
'检查文件是否已经存在
xYesorNo = MsgBox("如果目标文件夹中存在同名文件，则会在文件名中自动添加数字后缀以区分重复" & vbCrLf & vbCrLf & "单击是继续，单击否取消", _
vbYesNo + vbQuestion, "文件存在")
If xYesorNo <> vbYes Then Exit Sub
对于 I = 0 到 UBound(xArrShetts)
设置 xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
x数 = 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
其他

结束如果
xArrShetts(I) = xStr
下一页

'创建 Outlook 电子邮件
设置 xOutlookObj = CreateObject("Outlook.Application")
设置 xEmailObj = xOutlookObj.CreateItem(0)
使用 xEmailObj
。显示
.To = "Ctracklegal@ctrack.com"
.CC =“”
.Subject = "????"
对于 I = 0 到 UBound(xArrShetts)
出错时继续下一步
.Attachments.Add xArrShetts(一)
下一页
如果 DisplayEmail = False 那么
。发送
退出小组
结束如果
结束

END SUB

东篱

大约 1 年前

#35336

该评论由网站上的主持人最小化

嗨@水晶
这太棒了-我正在努力解决的关键问题是文件名-我希望文件名从工作表中的单元格中提取，而不是使用选项卡名称。我已经编辑了代码以自动保存到指定的文件夹，但正在为文件名而苦苦挣扎。
请问您能提供什么帮助吗？

水晶东篱

大约 1 年前

#35337

该评论由网站上的主持人最小化

您好 Tori，如果您想用特定的单元格值命名 PDF 文件，请尝试以下代码。运行代码并选择一个文件夹来保存文件后，会弹出另一个对话框，请选择您将使用的单元格该值作为 PDF 文件的名称，然后单击“确定”完成。
Sub Saveaspdfandsend2()
'更新者 Extendoffice 20210521
将 xSht 调暗为工作表
将 xFileDlg 调暗为 FileDialog
将 xFolder 调暗为字符串
将 xYesorNo 调暗为整数
将 xOutlookObj 调暗为对象
将 xEmailObj 调暗为对象
将 xUsedRng、xRgInser 调暗为范围
将 xB 调暗为布尔值
设置 xSht = ActiveSheet
设置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那么
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必须指定一个文件夹来保存 PDF。" & vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "必须指定目标文件夹"
退出小组
结束如果
xB = 真
出错时继续下一步
而xB
设置 xRgInser = 无
Set xRgInser = Application.InputBox("选择一个单元格，您将使用该值来命名 PDF 文件：", "Kutools for Excel", , , , , , 8)
如果 xRgInser 什么都不是，那么
MsgBox "没有选择单元格，退出操作！", vbInformation, "Kutools for Excel"
退出小组
结束如果
如果 xRgInser.Text = "" 那么
MsgBox "所选单元格为空白，请重新选择！", vbInformation, "Kutools for Excel"
其他
xB = 假
结束如果
蜿蜒

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

'检查文件是否已经存在
如果 Len(Dir(xFolder)) > 0 那么
xYesorNo = MsgBox(xFolder & " 已经存在。" & vbCrLf & vbCrLf & "你想覆盖它吗？", _
vbYesNo + vbQuestion, "文件存在")
出错时继续下一步
如果 xYesorNo = vbYes 那么
杀死 xFolder
其他
MsgBox "如果您不覆盖现有的 PDF，我将无法继续。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小组
结束如果
如果 Err.Number <> 0 则
MsgBox "无法删除现有文件。请确保文件未打开或未写保护。" _
& vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "无法删除文件"
退出小组
结束如果
结束如果

设置 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 = ""
.CC =“”
.Subject = xSht.Name + ".pdf"
.Attachments.Add x文件夹
如果 DisplayEmail = False 那么
'。发送
结束如果
结束
其他
MsgBox "活动工作表不能为空"
退出小组
结束如果
END SUB

报告

马克欧佩努

大约 1 年前

#35342

该评论由网站上的主持人最小化

嗨，我需要类似的东西，所以这就是我得到的。它采用当前日期并在特定位置创建一个带有日期名称的新文件夹。它将 pdf 放在该新位置，然后将 pdf 附加到新电子邮件中。作为一种享受。我只是一个初学者，所以如果它看起来一团糟，请原谅我。 :D
子 PDFTOEMAIL()
将 xSht 调暗为工作表
将 xFileDlg 调暗为 FileDialog
将 xFolder 调暗为字符串
将 xYesorNo 调暗为整数
将 xOutlookObj 调暗为对象
将 xEmailObj 调暗为对象
将 xUsedRng 调暗为范围
将 xPath 调暗为字符串
将 xOutMsg 调暗为字符串
将 sFolderName 作为字符串调暗，将 sFolder 作为字符串调暗
将 sFolderPath 调暗为字符串

设置 xSht = ActiveSheet
xFileDate = 格式（现在，“dd-mm-yyyy”）
sFolder = "C:" '这里有一个主文件夹
sFolderName = "周结束" + Format(Now, "dd-mm-yyyy") '要在主文件夹中创建的文件夹，名称为周结束和当前日期
sFolderPath = "C:" & sFolderName '主文件夹再次创建包含新文件夹的新路径
设置 oFSO = CreateObject("Scripting.FileSystemObject")
如果 oFSO.FolderExists(sFolderPath) 那么
MsgBox "文件夹已经存在！" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
其他
MkDir s文件夹路径
MsgBox "新文件夹已创建！" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
结束如果
xPath = s文件夹路径
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
如果 Len(Dir(xFolder)) > 0 那么
xYesorNo = MsgBox(xFolder & " 已经存在。" & vbCrLf & vbCrLf & "你想覆盖它吗？", _
vbYesNo + vbQuestion, "文件存在")
出错时继续下一步
如果 xYesorNo = vbYes 那么
杀死 xFolder
其他
MsgBox "如果您不覆盖现有的 PDF，我将无法继续。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小组
结束如果
如果 Err.Number <> 0 则
MsgBox "无法删除现有文件。请确保文件未打开或未写保护。" _
& vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "无法删除文件"
退出小组
结束如果
结束如果

设置 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 for week ending " + xFileDate + " - Location " ' 主题包括工作表名称、pdf、日期和位置，可根据需要进行编辑
.Attachments.Add x文件夹
.HTMLBody = xOutMsg & .HTMLBody
如果 DisplayEmail = False 那么
'.Send <--- 这里如果你删除撇号，邮件会自动发送，所以请小心
结束如果
结束
其他
MsgBox "活动工作表不能为空"
退出小组
结束如果
END SUB

报告

妮可

大约 1 年前

#35677

该评论由网站上的主持人最小化

如何编辑此代码以仅保存单元格（“a1：r99”）以另存为 PDF。我的 PDF 文档中有我不想要的额外内容。
子另存为pdfandsend()
'更新者 Extendoffice 20210209
将 xSht 调暗为工作表
将 xFileDlg 调暗为 FileDialog
将 xFolder 调暗为字符串
将 xYesorNo 调暗为整数
将 xOutlookObj 调暗为对象
将 xEmailObj 调暗为对象
将 xUsedRng 调暗为范围
将 xStrName 调暗为字符串
将 xV 变暗为变体

设置 xSht = ActiveSheet
设置 xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFileDlg.Show = True 那么
xFolder = xFileDlg.SelectedItems(1)
其他
MsgBox "您必须指定一个文件夹来保存 PDF。" & vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "必须指定目标文件夹"
退出小组
结束如果
xStrName = ""
xV = Application.InputBox("请输入文件名:", "Kutools for Excel", , , , , , 2)
如果 xV = False 那么
退出小组
结束如果
xStrName = xV
如果 xStrName = "" 那么
MsgBox ("没有输入文件名，正在退出进程！")
退出小组
结束如果

xFolder = xFolder + "\" + xStrName + ".pdf"
'检查文件是否已经存在
如果 Len(Dir(xFolder)) > 0 那么
xYesorNo = MsgBox(xFolder & " 已经存在。" & vbCrLf & vbCrLf & "你想覆盖它吗？", _
vbYesNo + vbQuestion, "文件存在")
出错时继续下一步
如果 xYesorNo = vbYes 那么
杀死 xFolder
其他
MsgBox "如果您不覆盖现有的 PDF，我将无法继续。" _
& vbCrLf & vbCrLf & "按 OK 退出此宏。", vbCritical, "退出宏"
退出小组
结束如果
如果 Err.Number <> 0 则
MsgBox "无法删除现有文件。请确保文件未打开或未写保护。" _
& vbCrLf & vbCrLf & "按确定退出此宏。", vbCritical, "无法删除文件"
退出小组
结束如果
结束如果

设置 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 = ""
.CC =“”
.Subject = xSht.Name + ".pdf"
.Attachments.Add x文件夹
如果 DisplayEmail = False 那么
'。发送
结束如果
结束
其他
MsgBox "活动工作表不能为空"
退出小组
结束如果
END SUB

RLF 妮可

大约 1 年前

#35678

该评论由网站上的主持人最小化

您好，我刚刚在我的一张工作表上尝试了此代码，并且我设置了打印区域，因此底部的额外内容没有出现在 pdf 中。尝试一下！

罗德贝内特

大约 1 年前

#35699

该评论由网站上的主持人最小化

Hi
非常感谢代码，但是是否可以将 PDF 自动保存到与活动 Excel 文件相同的位置，并且文件名与活动 Excel 文件相同？
非常感谢。
竿

这里还没有评论

加载更多

留下你的意见

以访客身份发帖

名字（必填）

电子邮件（必填）

评价此帖子：

重设

0 产品特性

我同意附带条约