ワークシートをPDFファイルとして保存し、Outlookから添付ファイルとして電子メールで送信するにはどうすればよいですか？

場合によっては、Outlookを介してワークシートをPDFファイルとして送信する必要があります。通常、ワークシートを手動でPDFファイルとして保存してから、このPDFファイルをOutlookの添付ファイルとして新しい電子メールを作成し、最後に送信する必要があります。手動で段階的に実行するには時間がかかります。この記事では、ワークシートをPDFファイルとしてすばやく保存し、ExcelのOutlookを介して添付ファイルとして自動的に送信する方法を示します。

ワークシートをPDFファイルとして保存し、VBAコードの添付ファイルとして電子メールで送信します

ワークシートをPDFファイルとして保存し、VBAコードの添付ファイルとして電子メールで送信します

すごい！ Chrome、Firefox、SafariなどのExcelで効率的なタブを使用する！

時間の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 以下のデモに示すように、XNUMXつまたは複数のワークシートを別々のPDFファイルとして一度に簡単に保存するのに役立ちます。 ダウンロードして今すぐ試してみてください！ (30- デイフリートレイル)

最高のオフィス生産性ツール

Kutools for Excelはほとんどの問題を解決し、生産性を80％向上させます

再利用: すばやく挿入 複雑な数式、チャート および以前に使用したものすべて。セルを暗号化するパスワード付き。メーリングリストを作成するそしてメールを送る...
スーパーフォーミュラバー（複数行のテキストと数式を簡単に編集できます）; 読書レイアウト（多数のセルを簡単に読み取って編集する）; フィルター範囲に貼り付け...
セル/行/列をマージするデータを失うことなく; 分割セルコンテンツ; 重複する行/列を組み合わせる...重複セルを防止します。範囲を比較する...
[複製]または[一意]を選択します行; 空白行を選択（すべてのセルは空です）; スーパーファインドとファジーファインド多くのワークブックで; ランダム選択...
正確なコピー数式参照を変更せずに複数のセル。参照の自動作成複数のシートに; 箇条書きを挿入、チェックボックスなど...
テキストを抽出、テキストの追加、位置による削除、スペースを削除する; ページング小計の作成と印刷。セルの内容とコメントを変換する...
スーパーフィルター（フィルタースキームを保存して他のシートに適用します）; 高度な並べ替え月/週/日、頻度など。特殊フィルター太字、斜体...
ワークブックとワークシートを組み合わせる; キー列に基づいてテーブルをマージします。データを複数のシートに分割; xls、xlsx、PDFをバッチ変換...
300 以上の強力な機能. Office / Excel 2007-2021 および 365 をサポートします。すべての言語をサポートします。企業や組織に簡単に導入できます。フル機能の 30 日間無料トライアル。 60日間の返金保証。

続きを読みます... 無料ダウンロード... 購入...

Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作業をはるかに簡単にします

Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
生産性を 50% 向上させ、毎日何百回もマウスクリックを減らすことができます!

続きを読みます... 無料ダウンロード... 購入...

コメント (63)

5の5を評価 · 1の評価

Michael Liebreich

約5年前

#20277

このコメントは、サイトのモデレーターによって最小化されました

これは私にとってはうまく機能していますが、手動で選択するのではなく、フォルダの場所を自動的に選択する方法はありますか？一度に40枚でこれをやりたいと思っています。

返信

ヒュー Michael Liebreich

約2年前

#20278

このコメントは、サイトのモデレーターによって最小化されました

また、この問題の答えを見たいと思っています！助けてくれてありがとう！

返信

ダレン

約5年前

#22279

このコメントは、サイトのモデレーターによって最小化されました

これを新しいモジュールに貼り付けようとしましたが、コンパイルエラーが発生します：サブまたは関数が定義されていません。助けてください。

返信

結晶ダレン

約5年前

#22280

このコメントは、サイトのモデレーターによって最小化されました

親愛なるダレン、
どのOfficeバージョンを使用していますか？

返信

レポート

ナキア結晶

約4年前

#22281

このコメントは、サイトのモデレーターによって最小化されました

オフィス360

返信

ビルダレン

約4年前

#22282

このコメントは、サイトのモデレーターによって最小化されました

同じ問題

返信

マイケル・チャリー

約4年前

#24346

このコメントは、サイトのモデレーターによって最小化されました

上記のVBAスクリプトを編集して、ファイル名に日付とタイムスタンプを追加し、すでに保存されているものを上書きし続けないようにするにはどうすればよいですか？

返信

レポート

結晶マイケル・チャリー

約4年前

#24347

このコメントは、サイトのモデレーターによって最小化されました

親愛なるマイケル、
問題を解決するには、以下のVBAコードを実行してください。

Sub Saveaspdfandsend（）
ワークシートとして薄暗いxSht
Dim xFileDlg As FileDialog
文字列としての薄暗いxFolder
Dim xYesorNo As Integer
オブジェクトとしての薄暗いxOutlookObj
オブジェクトとしての薄暗いxEmailObj
Dim xUsedRng As Range
文字列としての薄暗いxStr

xSht=ActiveSheetに設定します
xFileDlg = Application.FileDialog（msoFileDialogFolderPicker）を設定します

xFileDlg.Show=Trueの場合
xFolder = xFileDlg.SelectedItems（1）
他
MsgBox「PDFを保存するフォルダを指定する必要があります。」＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"宛先フォルダーを指定する必要があります"
サブを終了
終了する場合
xStr = Format（Now（）、 "yyyy-mm-dd-hh-mm-ss"）
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'ファイルがすでに存在するかどうかを確認します
Len（Dir（xFolder））>0の場合Then
xYesorNo = MsgBox（xFolder＆ "はすでに存在します。"＆vbCrLf＆vbCrLf＆ "上書きしますか？"、_
vbYesNo + vbQuestion、 "ファイルが存在します"）
エラーで次の再開
xYesorNo=vbYesの場合
xFolderを殺す
他
MsgBox「既存のPDFを上書きしないと、続行できません。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"マクロを終了します "
サブを終了
終了する場合
Err.Number<>0の場合Then
MsgBox「既存のファイルを削除できません。ファイルが開いていないか、書き込み保護されていないことを確認してください。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"ファイルを削除できません "
サブを終了
終了する場合
終了する場合

xUsedRng=xSht.UsedRangeを設定します
If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then
'PDFファイルとして保存
xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xFolder、Quality：= xlQualityStandard

'Outlookメールを作成する
xOutlookObj = CreateObject（ "Outlook.Application"）を設定します
xEmailObj = xOutlookObj.CreateItem（0）を設定します
xEmailObjを使用
。表示
.To = ""
.CC = ""
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Attachments.AddxFolder
DisplayEmail=Falseの場合
'。送信
終了する場合
最後に
他
MsgBox「アクティブなワークシートを空白にすることはできません」
サブを終了
終了する場合
End Subの

返信

レポート

パラグソマニ結晶

約3年前

#24348

このコメントは、サイトのモデレーターによって最小化されました

こんにちはクリスタル、

それは本当に素晴らしく、私にとって完璧に機能しています。追加するためにさらに助けが必要です：

1.「To」でアクティブシートの特定のセルにリンクを付けたいCCとBCCでアクティブシートのリンクを追加したい
2.電子メールの本文で、いくつかの標準テキストを指定する必要があります。

私はあなたの助けのためにあなたに大いにいっぱいになります。

感謝
パラグ

返信

結晶パラグソマニ

約3年前

#24349

このコメントは、サイトのモデレーターによって最小化されました

こんにちはパラグソマニ、
以下のVBAコードが役立ちます。必要に応じて、.To、.CC、.BCC、および.Bodyフィールドを変更してください。

Sub Saveaspdfandsend（）
ワークシートとして薄暗いxSht
Dim xFileDlg As FileDialog
文字列としての薄暗いxFolder
Dim xYesorNo As Integer
オブジェクトとしての薄暗いxOutlookObj
オブジェクトとしての薄暗いxEmailObj
Dim xUsedRng As Range
文字列としての薄暗いxStr

xSht=ActiveSheetに設定します
xFileDlg = Application.FileDialog（msoFileDialogFolderPicker）を設定します

xFileDlg.Show=Trueの場合
xFolder = xFileDlg.SelectedItems（1）
他
MsgBox「PDFを保存するフォルダを指定する必要があります。」＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"宛先フォルダーを指定する必要があります"
サブを終了
終了する場合
xStr = Format（Now（）、 "yyyy-mm-dd-hh-mm-ss"）
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'ファイルがすでに存在するかどうかを確認します
Len（Dir（xFolder））>0の場合Then
xYesorNo = MsgBox（xFolder＆ "はすでに存在します。"＆vbCrLf＆vbCrLf＆ "上書きしますか？"、_
vbYesNo + vbQuestion、 "ファイルが存在します"）
エラーで次の再開
xYesorNo=vbYesの場合
xFolderを殺す
他
MsgBox「既存のPDFを上書きしないと、続行できません。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"マクロを終了します "
サブを終了
終了する場合
Err.Number<>0の場合Then
MsgBox「既存のファイルを削除できません。ファイルが開いていないか、書き込み保護されていないことを確認してください。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"ファイルを削除できません "
サブを終了
終了する場合
終了する場合

xUsedRng=xSht.UsedRangeを設定します
If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then
'PDFファイルとして保存
xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xFolder、Quality：= xlQualityStandard

'Outlookメールを作成する
xOutlookObj = CreateObject（ "Outlook.Application"）を設定します
xEmailObj = xOutlookObj.CreateItem（0）を設定します
xEmailObjを使用
。表示
.To = Range（ "A8"）
.CC = Range（ "A9"）
.BCC = Range（ "A10"）
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Body="親愛なる"_
＆vbNewLine＆vbNewLine＆_
「これはテストメールです」＆_
「Excelで送信」
.Attachments.AddxFolder
DisplayEmail=Falseの場合
'。送信
終了する場合
最後に
他
MsgBox「アクティブなワークシートを空白にすることはできません」
サブを終了
終了する場合
End Subの

返信

レポート

Mehul 結晶

約11ヶ月前

#24350

このコメントは、サイトのモデレーターによって最小化されました

「To」、「CC」の範囲を使用しようとしましたが、指定されたセルから値を取得しません。これを手伝ってもらえますか？
おかげで、
Mehul

返信

パラグソマニ結晶

約3年前

#24351

このコメントは、サイトのモデレーターによって最小化されました

こんにちはクリスタル、

それは本当に素晴らしく、私にとって完璧に機能しています。追加するためにさらに助けが必要です：

1.「宛先」でアクティブシートの特定のセルへのリンクをCCと同様に指定したいBCCでアクティブシートのリンクを追加したい
2.電子メールの本文で、いくつかの標準テキストを指定する必要があります。

私はあなたの助けのためにあなたに大いにいっぱいになります。

感謝
パラグ

返信

パラグ結晶

約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では、XNUMXつの異なるセルから収集したいと思います。これは可能ですか？

返信

テイラー奇数インジ

約2年前

#30840

このコメントは、サイトのモデレーターによって最小化されました

これは可能です。セルからの値を保持するために個別の変数を作成し、xFolderを設定するときにそれらの変数を使用します。
シートのセルの値と今日の日付を使用しました。ただし、複数のセル値を簡単に実行できます。

これは私が追加したものです：
Dim xMemberName を文字列として
Dim xFileDate を文字列として

xMemberName = Range（ "H3"）。Value
xFileDate = Format（Now、 "mm-dd"）

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

返信

ソーラテイラー

約4ヶ月前

#40196

このコメントは、サイトのモデレーターによって最小化されました

これを試すとエラーが発生します。これをコードのどこに配置すればよいですか?

返信

キショア

約2年前

#32506

このコメントは、サイトのモデレーターによって最小化されました

こんにちはクリスタル、

それは本当に素晴らしく、私にとって完璧に機能しています。追加するためにさらに助けが必要です：

1.「ボディ」でアクティブシートの特定のセルにリンクを付けたい。さらにテキストを太字にします。

感謝

よろしく

キショアクマール

返信

レポート

結晶キショア

約2年前

#32507

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、

セルの値をメール本文に自動的に追加して太字にするという意味ですか？メール本文にC4の値を追加するとします。以下のコードを適用してください。

Sub Saveaspdfandsend（）

ワークシートとして薄暗いxSht

Dim xFileDlg As FileDialog

文字列としての薄暗いxFolder

Dim xYesorNo As Integer

オブジェクトとしての薄暗いxOutlookObj

オブジェクトとしての薄暗いxEmailObj

Dim xUsedRng As Range

xSht=ActiveSheetに設定します

xFileDlg = Application.FileDialog（msoFileDialogFolderPicker）を設定します

xFileDlg.Show=Trueの場合

xFolder = xFileDlg.SelectedItems（1）

他

MsgBox「PDFを保存するフォルダを指定する必要があります。」＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"宛先フォルダーを指定する必要があります"

サブを終了

終了する場合

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

'ファイルがすでに存在するかどうかを確認します

Len（Dir（xFolder））>0の場合Then

xYesorNo = MsgBox（xFolder＆ "はすでに存在します。"＆vbCrLf＆vbCrLf＆ "上書きしますか？"、_

vbYesNo + vbQuestion、 "ファイルが存在します"）

エラーで次の再開

xYesorNo=vbYesの場合

xFolderを殺す

他

MsgBox「既存のPDFを上書きしないと、続行できません。」 _

＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"マクロを終了します "

サブを終了

終了する場合

Err.Number<>0の場合Then

MsgBox「既存のファイルを削除できません。ファイルが開いていないか、書き込み保護されていないことを確認してください。」 _

＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"ファイルを削除できません "

サブを終了

終了する場合

終了する場合

xUsedRng=xSht.UsedRangeを設定します

If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then

'PDFファイルとして保存

xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xFolder、Quality：= xlQualityStandard

'Outlookメールを作成する

xOutlookObj = CreateObject（ "Outlook.Application"）を設定します

xEmailObj = xOutlookObj.CreateItem（0）を設定します

xEmailObjを使用

。表示

.To = ""

.CC = ""

.Subject = xSht.Name + ".pdf"

.Attachments.AddxFolder

.HTMLBody = "
"＆Range（" C4 "）＆。HTMLBody

DisplayEmail=Falseの場合

'。送信

終了する場合

最後に

他

MsgBox「アクティブなワークシートを空白にすることはできません」

サブを終了

終了する場合

End Subの

返信

レポート

ジェフ

約2年前

#33679

このコメントは、サイトのモデレーターによって最小化されました

毎回特定のフォルダーに自動保存したい場合（ユーザーがフォルダーを選択する必要がない場合）、どうすればよいですか？
元。 C：請求書/ NorthAmerica / Clients
ヘルプは大歓迎です。

返信

結晶ジェフ

約2年前

#33680

このコメントは、サイトのモデレーターによって最小化されました

こんにちはジェフ、
ワークシートをPDFファイルとして保存し、送信せずに特定のフォルダーに保存するという意味ですか？

返信

レポート

ジェレミー結晶

約2年前

#33681

このコメントは、サイトのモデレーターによって最小化されました

Geoffとは、場所を手動で選択するのではなく、PDFが保存されるコード内の特定のフォルダーを毎回指定できることを意味すると思います。次に、PDFはその特定のフォルダーから電子メールで送信されます。

返信

結晶ジェレミー

約2年前

#33682

このコメントは、サイトのモデレーターによって最小化されました

ジェレミーありがとう。

返信

レポート

結晶ジェフ

約2年前

#33683

このコメントは、サイトのモデレーターによって最小化されました

こんにちはジェフ、手動で場所を選択するのではなく、PDFファイルを特定のフォルダに自動的に保存したい場合は、以下のコードを試してください。コード内のフォルダパスを変更することを忘れないでください。
サブSaveAsPDFandSend（）
ワークシートとして薄暗いxSht
Dim xFileDlg As FileDialog
文字列としての薄暗いxFolder
Dim xYesorNo As Integer
オブジェクトとしての薄暗いxOutlookObj
オブジェクトとしての薄暗いxEmailObj
Dim xUsedRng As Range
文字列としてのDimxPath
xSht=ActiveSheetに設定します
xPath = "C：\ Users \ Win10x64Test \ Desktop \ worksheet to pdf"'ここで"workshetto pdf "は、pdfファイルを保存する宛先フォルダーです。
xFolder = xPath + "\" + xSht.Name + ".pdf"
Len（Dir（xFolder））>0の場合Then
xYesorNo = MsgBox（xFolder＆ "はすでに存在します。"＆vbCrLf＆vbCrLf＆ "上書きしますか？"、_
vbYesNo + vbQuestion、 "ファイルが存在します"）
エラーで次の再開
xYesorNo=vbYesの場合
xFolderを殺す
他
MsgBox「既存のPDFを上書きしないと、続行できません。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"マクロを終了します "
サブを終了
終了する場合
Err.Number<>0の場合Then
MsgBox「既存のファイルを削除できません。ファイルが開いていないか、書き込み保護されていないことを確認してください。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"ファイルを削除できません "
サブを終了
終了する場合
終了する場合

xUsedRng=xSht.UsedRangeを設定します
If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then
'PDFファイルとして保存
xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xFolder、Quality：= xlQualityStandard

'Outlookメールを作成する
xOutlookObj = CreateObject（ "Outlook.Application"）を設定します
xEmailObj = xOutlookObj.CreateItem（0）を設定します
xEmailObjを使用
。表示
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.AddxFolder
DisplayEmail=Falseの場合
'。送信
終了する場合
最後に
他
MsgBox「アクティブなワークシートを空白にすることはできません」
サブを終了
終了する場合
End Subの

返信

レポート

アリソン

約2年前

#34153

このコメントは、サイトのモデレーターによって最小化されました

このコードは、ワークシートをシート名+日付（つまり、Sheet1 1年2020月XNUMX日）として保存したい場合を除いて、うまく機能します。ユーザーのデスクトップ上（これは複数のユーザーによって使用され、パスはわずかに異なる場合があります）。可能であれば、本文にも.jpgを埋め込みたいと思います。JPGはワークシートの内側（印刷領域の外側）にあり、画像は共有サーバーに保存されます。サーバーへのパスはさまざまですがユーザー（ほとんどの場合、「U」ドライブの場合は「T」ドライブです）
これはできますか？何百万回もありがとうございます。

返信

ディーパック

約2年前

#34748

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、それはうまく機能しています共有していただきありがとうございます、ただXNUMXつの助けが必要です。
カスタマイズされた名前（[名前を付けて保存]ダイアログボックスにファイル名を入力するオプション）でPDFファイルを保存する場合、ユーザーがフォームテンプレートでこのオプションを使用すると、フォームは一意の名前でPDFとして保存されます。

返信

レポート

結晶ディーパック

約1年前

#34749

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、以下のVBAコードをお試しください。コードを実行した後、PDFファイルを保存するフォルダーを選択すると、ファイル名を入力するためのダイアログボックスが表示されます。 Sub Saveaspdfandsend（）
'によって更新されました Extendoffice 20210209
ワークシートとして薄暗いxSht
Dim xFileDlg As FileDialog
文字列としての薄暗いxFolder
Dim xYesorNo As Integer
オブジェクトとしての薄暗いxOutlookObj
オブジェクトとしての薄暗いxEmailObj
Dim xUsedRng As Range
Dim xStrName を文字列として
バリアントとしての薄暗いxV

xSht=ActiveSheetに設定します
xFileDlg = Application.FileDialog（msoFileDialogFolderPicker）を設定します

xFileDlg.Show=Trueの場合
xFolder = xFileDlg.SelectedItems（1）
他
MsgBox「PDFを保存するフォルダを指定する必要があります。」＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"宛先フォルダーを指定する必要があります"
サブを終了
終了する場合
xStrName = ""
xV = Application.InputBox（ "ファイル名を入力してください："、 "Kutools for Excel" 、、、、、、、 2）
xV=Falseの場合
サブを終了
終了する場合
xStrName = xV
xStrName=""の場合
MsgBox（ "ファイル名が入力されていません、プロセスを終了します！"）
サブを終了
終了する場合

xFolder = xFolder + "\" + xStrName + ".pdf"
'ファイルがすでに存在するかどうかを確認します
Len（Dir（xFolder））>0の場合Then
xYesorNo = MsgBox（xFolder＆ "はすでに存在します。"＆vbCrLf＆vbCrLf＆ "上書きしますか？"、_
vbYesNo + vbQuestion、 "ファイルが存在します"）
エラーで次の再開
xYesorNo=vbYesの場合
xFolderを殺す
他
MsgBox「既存のPDFを上書きしないと、続行できません。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"マクロを終了します "
サブを終了
終了する場合
Err.Number<>0の場合Then
MsgBox「既存のファイルを削除できません。ファイルが開いていないか、書き込み保護されていないことを確認してください。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"ファイルを削除できません "
サブを終了
終了する場合
終了する場合

xUsedRng=xSht.UsedRangeを設定します
If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then
'PDFファイルとして保存
xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xFolder、Quality：= xlQualityStandard

'Outlookメールを作成する
xOutlookObj = CreateObject（ "Outlook.Application"）を設定します
xEmailObj = xOutlookObj.CreateItem（0）を設定します
xEmailObjを使用
。表示
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.AddxFolder
DisplayEmail=Falseの場合
'。送信
終了する場合
最後に
他
MsgBox「アクティブなワークシートを空白にすることはできません」
サブを終了
終了する場合
End Subの

返信

レポート

mleczus94

約1年前

#35017

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、
ファイルにXNUMXつのシートがあり、このマクロをXNUMXつのシートで（ボタンを押して）実行したいが、別のシートを送信したい場合、どうすれば取得できますか？

返信

レポート

ハァッ

約1年前

#35061

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、セルC30の値に基づいた名前で、これを特定のファイルの場所に保存したいと思います。いくつかのオプションを試しましたが、エラーが発生し続けます。

返信

結晶ハァッ

約1年前

#35062

このコメントは、サイトのモデレーターによって最小化されました

こんにちはハイン、以下のコードが役立つかもしれません。コードを実行した後、PDFファイルを保存する特定のフォルダーを選択すると、ファイル名を入力するためのダイアログボックスがポップアップ表示されます。 Sub Saveaspdfandsend（）
'によって更新されました Extendoffice 20210209
ワークシートとして薄暗いxSht
Dim xFileDlg As FileDialog
文字列としての薄暗いxFolder
Dim xYesorNo As Integer
オブジェクトとしての薄暗いxOutlookObj
オブジェクトとしての薄暗いxEmailObj
Dim xUsedRng As Range
Dim xStrName を文字列として
バリアントとしての薄暗いxV

xSht=ActiveSheetに設定します
xFileDlg = Application.FileDialog（msoFileDialogFolderPicker）を設定します

xFileDlg.Show=Trueの場合
xFolder = xFileDlg.SelectedItems（1）
他
MsgBox「PDFを保存するフォルダを指定する必要があります。」＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"宛先フォルダーを指定する必要があります"
サブを終了
終了する場合
xStrName = ""
xV = Application.InputBox（ "ファイル名を入力してください："、 "Kutools for Excel" 、、、、、、、 2）
xV=Falseの場合
サブを終了
終了する場合
xStrName = xV
xStrName=""の場合
MsgBox（ "ファイル名が入力されていません、プロセスを終了します！"）
サブを終了
終了する場合

xFolder = xFolder + "\" + xStrName + ".pdf"
'ファイルがすでに存在するかどうかを確認します
Len（Dir（xFolder））>0の場合Then
xYesorNo = MsgBox（xFolder＆ "はすでに存在します。"＆vbCrLf＆vbCrLf＆ "上書きしますか？"、_
vbYesNo + vbQuestion、 "ファイルが存在します"）
エラーで次の再開
xYesorNo=vbYesの場合
xFolderを殺す
他
MsgBox「既存のPDFを上書きしないと、続行できません。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"マクロを終了します "
サブを終了
終了する場合
Err.Number<>0の場合Then
MsgBox「既存のファイルを削除できません。ファイルが開いていないか、書き込み保護されていないことを確認してください。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"ファイルを削除できません "
サブを終了
終了する場合
終了する場合

xUsedRng=xSht.UsedRangeを設定します
If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then
'PDFファイルとして保存
xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xFolder、Quality：= xlQualityStandard

'Outlookメールを作成する
xOutlookObj = CreateObject（ "Outlook.Application"）を設定します
xEmailObj = xOutlookObj.CreateItem（0）を設定します
xEmailObjを使用
。表示
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.AddxFolder
DisplayEmail=Falseの場合
'。送信
終了する場合
最後に
他
MsgBox「アクティブなワークシートを空白にすることはできません」
サブを終了
終了する場合
End Subの

返信

レポート

ハイン結晶

約1年前

#35063

このコメントは、サイトのモデレーターによって最小化されました

それをありがとう、それは素晴らしいです、しかし私はシートがシート1のセルA1に従って名前を付けられることを望みます。例えばC：\ Users \ peete \ Dropbox \ Screenshots、そして電子メールがに送られるシート1のA2に従って保存する場所A3シート2のメールアドレス。

返信

ハインピーターズ結晶

約1年前

#35064

このコメントは、サイトのモデレーターによって最小化されました

おかげで、それは素晴らしいですが、シート1のセルA1に従ってシートに名前を付けたいと思います。たとえば、C：\ Users \ peete \ Dropbox \ Screenshotsのように、シート1のA2に従って保存する場所です。ファイルを使用して、A3シート2の電子メールアドレスに電子メールを送信します。

返信

レポート

ベンスポ

約1年前

#35283

このコメントは、サイトのモデレーターによって最小化されました

Hi 結晶、共有してくれてありがとう優れたコード。（同じワークブックから）複数のシートを選択して、それぞれを独立したPDFとして保存し、それらすべてをXNUMXつの電子メールに添付して送信する方法はありますか？

返信

レポート

結晶ベンスポ

約1年前

#35284

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、以下のVBAコードをお試しください。コードのXNUMX行目で、シート名を実際のシート名に置き換えてください。
Sub Saveaspdfandsend1（）
ワークシートとして薄暗いxSht
Dim xFileDlg As FileDialog
文字列としての薄暗いxFolder
Dim xYesorNo、I、xNum As Integer
オブジェクトとしての薄暗いxOutlookObj
オブジェクトとしての薄暗いxEmailObj
Dim xUsedRng As Range
バリアントとしての薄暗いxArrShetts
Dim xPDFNameAddress を文字列として
文字列としての薄暗いxStr
xArrShetts = Array（"テスト", 「シート1」, 「シート2」）'送信するシート名を引用符で囲んだPDFファイルとして入力し、コンマで区切ります。ファイル名に\/： "*<>|などの特殊文字が含まれていないことを確認してください。

I = 0の場合UBound（xArrShetts）へ
エラーで次の再開
xSht = Application.ActiveWorkbook.Worksheets（xArrShetts（I））を設定します
If xSht.Name <> xArrShetts（I）Then
MsgBox "ワークシートが見つかりません、操作を終了します："＆vbCrLf＆vbCrLf＆xArrShetts（I）、vbInformation、 "Kutools for Excel"
サブを終了
終了する場合
次へ

xFileDlg = Application.FileDialog（msoFileDialogFolderPicker）を設定します
xFileDlg.Show=Trueの場合
xFolder = xFileDlg.SelectedItems（1）
他
MsgBox「PDFを保存するフォルダを指定する必要があります。」＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"宛先フォルダーを指定する必要があります"
サブを終了
終了する場合
'ファイルがすでに存在するかどうかを確認します
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
Not（Dir（xStr、vbDirectory）= vbNullString）
xStr = xFolder＆ "\"＆xSht.Name＆ "_"＆xNum＆"。pdf"
xNum = xNum + 1
Wend
xUsedRng=xSht.UsedRangeを設定します
If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then
xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xStr、Quality：= xlQualityStandard
他

終了する場合
xArrShetts（I）= xStr
次へ

'Outlookメールを作成する
xOutlookObj = CreateObject（ "Outlook.Application"）を設定します
xEmailObj = xOutlookObj.CreateItem（0）を設定します
xEmailObjを使用
。表示
.To = ""
.CC = ""
.Subject = "????"
I = 0の場合UBound（xArrShetts）へ
.Attachments.Add xArrShetts（I）
次へ
DisplayEmail=Falseの場合
'。送信
終了する場合
最後に
End Subの

返信

レポート

ベルネールドルフ結晶

約1年前

#35285

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、私が苦労しているXNUMXつの変更は、作成されたpdfドキュメントごとに個別の電子メールを作成することです。

返信

結晶ベルネールドルフ

約1年前

#35286

このコメントは、サイトのモデレーターによって最小化されました

こんにちは。PDFドキュメントごとに個別のメールを作成するには、投稿で提供されているVBAをさまざまなワークシートで手動で実行して実行します。

返信

レポート

ベルネールドルフ結晶

約1年前

#35287

このコメントは、サイトのモデレーターによって最小化されました

ワークブックに100を超えるワークシートがあり、VBAを100回以上実行する必要があり、これには時間がかかります。
ブックを複数のシートに分割して、各ワークシートを個別のPDFドキュメントに変換することができました。
私が探している解決策は、上記のプロセスの実行中に各PDFドキュメントを個別に電子メールで送信することです。
これにより、私が現在実行しているVBAは次のようになります。
Sub Saveaspdfandsend1（）
ワークシートとして薄暗いxSht
Dim xFileDlg As FileDialog
文字列としての薄暗いxFolder
Dim xYesorNo、I、xNum As Integer
オブジェクトとしての薄暗いxOutlookObj
オブジェクトとしての薄暗いxEmailObj
Dim xUsedRng As Range
バリアントとしての薄暗いxArrShetts
Dim xPDFNameAddress を文字列として
文字列としての薄暗い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）へ
エラーで次の再開
xSht = Application.ActiveWorkbook.Worksheets（xArrShetts（I））を設定します
If xSht.Name <> xArrShetts（I）Then
MsgBox "ワークシートが見つかりません、操作を終了します："＆vbCrLf＆vbCrLf＆xArrShetts（I）、vbInformation、 "Kutools for Excel"
サブを終了
終了する場合
次へ

xFileDlg = Application.FileDialog（msoFileDialogFolderPicker）を設定します
xFileDlg.Show=Trueの場合
xFolder = xFileDlg.SelectedItems（1）
他
MsgBox「PDFを保存するフォルダを指定する必要があります。」＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"宛先フォルダーを指定する必要があります"
サブを終了
終了する場合
'ファイルがすでに存在するかどうかを確認します
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
Not（Dir（xStr、vbDirectory）= vbNullString）
xStr = xFolder＆ "\"＆xSht.Name＆ "_"＆xNum＆"。pdf"
xNum = xNum + 1
Wend
xUsedRng=xSht.UsedRangeを設定します
If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then
xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xStr、Quality：= 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（I）
次へ
DisplayEmail=Falseの場合
。送信
サブを終了
終了する場合
最後に

End Subの

返信

トーリ

約1年前

#35336

このコメントは、サイトのモデレーターによって最小化されました

こんにちは@crystal
これはファブです-私が苦労している重要なことはファイル名です-タブ名を使用するのではなく、ワークシートのセルからファイル名を取得したいと思います。指定したフォルダに自動的に保存するようにコードを編集しましたが、ファイル名に苦労しています。
あなたが提供できる助けはありますか？

返信

結晶トーリ

約1年前

#35337

このコメントは、サイトのモデレーターによって最小化されました

こんにちは鳥、特定のセル値でPDFファイルに名前を付けたい場合は、次のコードを試してください。コードを実行し、ファイルを保存するフォルダを選択した後、別のダイアログボックスが表示されたら、使用するセルを選択してくださいPDFファイルの名前としての値を入力し、[OK]をクリックして終了します。
Sub Saveaspdfandsend2（）
'によって更新されました Extendoffice 20210521
ワークシートとして薄暗いxSht
Dim xFileDlg As FileDialog
文字列としての薄暗いxFolder
Dim xYesorNo As Integer
オブジェクトとしての薄暗いxOutlookObj
オブジェクトとしての薄暗いxEmailObj
Dim xUsedRng、xRgInser As Range
Dim xB As Boolean
xSht=ActiveSheetに設定します
xFileDlg = Application.FileDialog（msoFileDialogFolderPicker）を設定します

xFileDlg.Show=Trueの場合
xFolder = xFileDlg.SelectedItems（1）
他
MsgBox「PDFを保存するフォルダを指定する必要があります。」＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"宛先フォルダーを指定する必要があります"
サブを終了
終了する場合
xB = 真
エラーで次の再開
xB中
xRgInser=Nothingを設定します
Set xRgInser = Application.InputBox（ "PDFファイルに名前を付けるために値を使用するセルを選択してください："、 "Kutools for Excel" 、、、、、、、 8）
xRgInserが何もない場合
MsgBox "セルが選択されていません。操作を終了してください！"、vbInformation、 "Kutools for Excel"
サブを終了
終了する場合
xRgInser.Text=""の場合
MsgBox "選択したセルが空白です。再選択してください！"、vbInformation、 "Kutools for Excel"
他
xB = 偽
終了する場合
Wend

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

'ファイルがすでに存在するかどうかを確認します
Len（Dir（xFolder））>0の場合Then
xYesorNo = MsgBox（xFolder＆ "はすでに存在します。"＆vbCrLf＆vbCrLf＆ "上書きしますか？"、_
vbYesNo + vbQuestion、 "ファイルが存在します"）
エラーで次の再開
xYesorNo=vbYesの場合
xFolderを殺す
他
MsgBox「既存のPDFを上書きしないと、続行できません。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"マクロを終了します "
サブを終了
終了する場合
Err.Number<>0の場合Then
MsgBox「既存のファイルを削除できません。ファイルが開いていないか、書き込み保護されていないことを確認してください。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"ファイルを削除できません "
サブを終了
終了する場合
終了する場合

xUsedRng=xSht.UsedRangeを設定します
If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then
'PDFファイルとして保存
xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xFolder、Quality：= xlQualityStandard

'Outlookメールを作成する
xOutlookObj = CreateObject（ "Outlook.Application"）を設定します
xEmailObj = xOutlookObj.CreateItem（0）を設定します
xEmailObjを使用
。表示
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.AddxFolder
DisplayEmail=Falseの場合
'。送信
終了する場合
最後に
他
MsgBox「アクティブなワークシートを空白にすることはできません」
サブを終了
終了する場合
End Subの

返信

レポート

マケウロピーヌ

約1年前

#35342

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、私は似たようなものが必要だったので、これが私が得たものです。現在の日付を取得し、特定の場所に日付名で新しいフォルダを作成します。その新しい場所にPDFを配置し、新しい電子メールにPDFを添付します。御馳走として動作します。私は初心者ですので、ごちゃごちゃしているようでしたら失礼します。：D
サブPDFTOEMAIL（）
ワークシートとして薄暗いxSht
Dim xFileDlg As FileDialog
文字列としての薄暗いxFolder
Dim xYesorNo As Integer
オブジェクトとしての薄暗いxOutlookObj
オブジェクトとしての薄暗いxEmailObj
Dim xUsedRng As Range
文字列としてのDimxPath
Dim xOutMsg を文字列として
Dim sFolderName As String、sFolder As String
Dim sFolderPath を文字列として

xSht=ActiveSheetに設定します
xFileDate = Format（Now、 "dd-mm-yyyy"）
sFolder = "C："'ここにメインフォルダがあります
sFolderName="週の終わり"+Format（Now、 "dd-mm-yyyy"）'週の終わりと現在の日付の名前でメインフォルダーに作成されるフォルダー
sFolderPath = "C："＆sFolderName'メインフォルダを再度作成して、新しいフォルダを含む新しいパスを作成します
Set oFSO = CreateObject（ "Scripting.FileSystemObject"）
if oFSO.FolderExists（sFolderPath）Then
MsgBox「フォルダはすでに存在します！」＆vbCrLf＆vbCrLf＆sFolderPath、vbInformation、 "INFO"
他
MkDir sFolderPath
MsgBox「新しいフォルダが作成されました！」＆vbCrLf＆vbCrLf＆sFolderPath、vbInformation、 "INFO"
終了する場合
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Len（Dir（xFolder））>0の場合Then
xYesorNo = MsgBox（xFolder＆ "はすでに存在します。"＆vbCrLf＆vbCrLf＆ "上書きしますか？"、_
vbYesNo + vbQuestion、 "ファイルが存在します"）
エラーで次の再開
xYesorNo=vbYesの場合
xFolderを殺す
他
MsgBox「既存のPDFを上書きしないと、続行できません。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"マクロを終了します "
サブを終了
終了する場合
Err.Number<>0の場合Then
MsgBox「既存のファイルを削除できません。ファイルが開いていないか、書き込み保護されていないことを確認してください。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"ファイルを削除できません "
サブを終了
終了する場合
終了する場合

xUsedRng=xSht.UsedRangeを設定します
If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then
xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xFolder、Quality：= xlQualityStandard
xOutlookObj = CreateObject（ "Outlook.Application"）を設定します
xEmailObj = xOutlookObj.CreateItem（0）を設定します
xOutMsg="添付ファイルを見つけてくださいこのメールと添付ファイルは自動的に生成されました"
'電子メールが自動的に生成されたというメモを追加します

xEmailObjを使用
。表示
.To =""'独自のメールアドレスを追加
.CC = ""
.Subject = xSht.Name+"週の終わりのPDF"+xFileDate +"-場所"'件名にはシート名、PDF、日付、場所が含まれます。これは必要に応じて編集できます
.Attachments.AddxFolder
.HTMLBody = xOutMsg＆.HTMLBody
DisplayEmail=Falseの場合
'.Send <---ここでアポストロフィを削除すると、メールが自動的に送信されますので、注意してください
終了する場合
最後に
他
MsgBox「アクティブなワークシートを空白にすることはできません」
サブを終了
終了する場合
End Subの

返信

レポート

ニコール

約1年前

#35677

このコメントは、サイトのモデレーターによって最小化されました

このコードを編集して、セル（ "a1：r99"）のみを保存してPDFとして保存するにはどうすればよいですか。 PDFドキュメントに不要な部分があります。
Sub Saveaspdfandsend（）
'によって更新されました Extendoffice 20210209
ワークシートとして薄暗いxSht
Dim xFileDlg As FileDialog
文字列としての薄暗いxFolder
Dim xYesorNo As Integer
オブジェクトとしての薄暗いxOutlookObj
オブジェクトとしての薄暗いxEmailObj
Dim xUsedRng As Range
Dim xStrName を文字列として
バリアントとしての薄暗いxV

xSht=ActiveSheetに設定します
xFileDlg = Application.FileDialog（msoFileDialogFolderPicker）を設定します

xFileDlg.Show=Trueの場合
xFolder = xFileDlg.SelectedItems（1）
他
MsgBox「PDFを保存するフォルダを指定する必要があります。」＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"宛先フォルダーを指定する必要があります"
サブを終了
終了する場合
xStrName = ""
xV = Application.InputBox（ "ファイル名を入力してください："、 "Kutools for Excel" 、、、、、、、 2）
xV=Falseの場合
サブを終了
終了する場合
xStrName = xV
xStrName=""の場合
MsgBox（ "ファイル名が入力されていません、プロセスを終了します！"）
サブを終了
終了する場合

xFolder = xFolder + "\" + xStrName + ".pdf"
'ファイルがすでに存在するかどうかを確認します
Len（Dir（xFolder））>0の場合Then
xYesorNo = MsgBox（xFolder＆ "はすでに存在します。"＆vbCrLf＆vbCrLf＆ "上書きしますか？"、_
vbYesNo + vbQuestion、 "ファイルが存在します"）
エラーで次の再開
xYesorNo=vbYesの場合
xFolderを殺す
他
MsgBox「既存のPDFを上書きしないと、続行できません。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"マクロを終了します "
サブを終了
終了する場合
Err.Number<>0の場合Then
MsgBox「既存のファイルを削除できません。ファイルが開いていないか、書き込み保護されていないことを確認してください。」 _
＆vbCrLf＆vbCrLf＆ "[OK]を押してこのマクロを終了します。"、vbCritical、"ファイルを削除できません "
サブを終了
終了する場合
終了する場合

xUsedRng=xSht.UsedRangeを設定します
If Application.WorksheetFunction.CountA（xUsedRng.Cells）<> 0 Then
'PDFファイルとして保存
xSht.ExportAsFixedFormat Type：= xlTypePDF、Filename：= xFolder、Quality：= xlQualityStandard

'Outlookメールを作成する
xOutlookObj = CreateObject（ "Outlook.Application"）を設定します
xEmailObj = xOutlookObj.CreateItem（0）を設定します
xEmailObjを使用
。表示
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.AddxFolder
DisplayEmail=Falseの場合
'。送信
終了する場合
最後に
他
MsgBox「アクティブなワークシートを空白にすることはできません」
サブを終了
終了する場合
End Subの

返信

RLF ニコール

約1年前

#35678

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、私はワークシートのXNUMXつでこのコードを試しましたが、印刷領域が設定されているため、下部の余分なものがPDFに表示されませんでした。それを試してみてください！

返信

ロッド・ベネット

約1年前

#35699

このコメントは、サイトのモデレーターによって最小化されました

Hi
コードに感謝しますが、PDFをアクティブなExcelファイルと同じ場所に、アクティブなExcelファイルと同じファイル名で自動的に保存することは可能ですか？
多くのおかげで。
ロッド

返信

ここにはまだコメントが投稿されていません