[[20200413195424]]　『VBAで選択したワークシートをPDF形式で保存したい』（マーミー）　ページの最後に飛ぶ

『VBAで選択したワークシートをPDF形式で保存したい』（マーミー）

ワークシートが選択シート、シート1、シート2、シート3、シート4、シート5とありまして、そして、選択シートのチェックボックスで選択されたシート1～シート5をPDF形式でデスクトップに保存したいです。
このような事がマクロを使用すれば、可能なのでしょうか？
マクロ初心者なもので、全然見当もつかないので、どなたか教えて頂けませんか？
よろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

Sub test1()

 Dim ws As Worksheet
 Dim cnt As Integer
 Dim myws As Worksheet
  Set myws = Worksheets("選択シート")
  cnt = 0
  For Each ws In ActiveWorkbook.Worksheets
   If ws.Name <> myws.Name Then
      cnt = cnt + 1
      myws.Cells(cnt, 1).Value = ws.Name
   End If
  Next ws
  Set myws = Nothing
End Sub

Sub test2()

 Dim fol As String
 Dim ws As Worksheet
 Dim myws As Worksheet
 Dim selrng As Range
 Dim rng As Range
  fol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Format(Now, "yymmddhhmmss")
  MkDir (fol)
  Set myws = Worksheets("選択シート")
  Set selrng = Selection
  For Each rng In selrng
   Set ws = ActiveWorkbook.Worksheets(rng.Value)
   Call SaveAsPDF(ws, fol)
   Set ws = Nothing
  Next rng
  Set myws = Nothing
End Sub

 Sub SaveAsPDF(ws As Worksheet, PA As String)
     ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PA & "\" & ws.Name & ".pdf", _
     Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
 End Sub

 ↓を参考にさせていただきました｡

[[20190307185138]]　『指定シート以外を個別にPDF化』（やすえ）
（OK） 2020/04/13(月) 20:41

 ↑はtest1で「選択シート」に選択シート以外のｼｰﾄ一覧を
 作成します。

 test2で、デスクトップ上に新規フォルダを作成し選択シートで
 選択したセルのシートを、シート名でPDF化し保存します。
（OK） 2020/04/13(月) 20:47

 チェックボックスだと、シート数が増減したときに面倒なので、
 ActiveXコントロールのListBoxにしてみました。
 ListBoxはふくすう選択が可能なので便利です。
 ブック起動時に選択シートのListBoxにシート一覧を
 格納します。

 ListBoxからPDF化したいシートを選択後、標準モジュールの
 testを実行します。

'ThisWorkbookモジュール

Private Sub Workbook_Open()

 Dim objlb As Object
 Dim ws As Worksheet
  Set objlb = Worksheets("選択シート").OLEObjects("ListBox1").Object
  objlb.MultiSelect = fmMultiSelectMulti
  For Each ws In ThisWorkbook.Worksheets
   If ws.Name <> "選択シート" Then
      objlb.AddItem ws.Name
   End If
  Next ws
  Set objlb = Nothing
End Sub

'標準モジュール
Sub test()

 Dim objlb As Object
 Dim i As Integer
 Dim ws As Worksheet
 Dim fol As String
  fol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Format(Now, "yymmddhhmmss")
  MkDir (fol)
  Set objlb = ThisWorkbook.Worksheets("選択シート").ListBox1
  If objlb.ListCount <> 0 Then
     For i = 0 To objlb.ListCount - 1
      If objlb.Selected(i) = True Then
         Set ws = ThisWorkbook.Worksheets(CStr(objlb.List(i)))
         Call SaveAsPDF(ws, fol)
         Set ws = Nothing
      End If
     Next i
  End If
  Set objlb = Nothing
End Sub

Sub SaveAsPDF(ws As Worksheet, PA As String)

     ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PA & "\" & ws.Name & ".pdf", _
     Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
 End Sub
（OK） 2020/04/13(月) 21:29

okさん、回答ありがとうございます。
ちょっとだけ質問したいのですが、
選択シートにActiveXコントロールのListBoxを作成しておけば、
良いのでしょうか？
（マーミー） 2020/04/13(月) 21:40

そうです。
（OK） 2020/04/13(月) 21:43

リストボックスの選択状態の解除の方法は
調べて見てください。
（OK） 2020/04/13(月) 21:58

例えば、リストボックスで複数のシートを選択し、１つのPDFファイルとして、保存する事も可能でしょうか？
度々、質問してしまい誠にすみません。
よろしくお願いします。
（マーミー） 2020/04/13(月) 22:12

参考過去ログです。

[[20190717150920]]　『シートを指定してPDFに出力』（チャロ）

回答を待つより過去ログ検索した方が解決が早いことも多いです。

複数のPDFを結合するソフトウェアを使うのも一つの手です。
（OK） 2020/04/13(月) 22:19

 複数シートを一つのPDFにするバージョンです。
 testの部分だけをtest2に置き換えてください。

'標準モジュール
Sub test2()

 Dim objlb As Object
 Dim i As Integer
 Dim ws As Worksheet
 Dim wsary() As Variant
 Dim wscnt As Integer
 Dim fol As String
  fol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Format(Now, "yymmddhhmmss")
  MkDir (fol)
  Set objlb = ThisWorkbook.Worksheets("選択シート").ListBox1
  wscnt = -1
  If objlb.ListCount <> 0 Then
     For i = 0 To objlb.ListCount - 1
      If objlb.Selected(i) = True Then
         wscnt = wscnt + 1
         ReDim Preserve wsary(0 To wscnt)
         wsary(wscnt) = ThisWorkbook.Worksheets(CStr(objlb.List(i))).Name
      End If
     Next i
  End If
  If wscnt <> -1 Then
     ThisWorkbook.Worksheets(wsary).Select
     Set ws = ActiveSheet
     Call SaveAsPDF(ws, fol)
     Set ws = Nothing
  End If
  Erase wsary
  Set objlb = Nothing
End Sub
（OK） 2020/04/14(火) 09:25

 ListBoxの選択解除の方法です。

Sub lbreset()

 Dim objlb As Object
 Dim i As Integer
  Set objlb = ThisWorkbook.Worksheets("選択シート").ListBox1
  For i = 0 To objlb.ListCount
   objlb.Selected(i) = False '選択解除
  Next i
  Set objlb = Nothing
End Sub
（OK） 2020/04/14(火) 09:54

 ListBoxのリスト順に結合されるので、結合したい順に
 ListBoxを並び替える機能も必要かもしれません。

 ↓はスピンボタンでListBoxの選択行を上下の行と入替え
 ます。ListBoxのMultiSelectをSingleにした状態
 で実行します。
 ListBoxのMultiSelectの切り替えはトグルボタンに
 よって行うようにしておきます。

 選択シートには、ListBox、スピンボタン、トグルボタン
 を各一つづつ配置しておきます。

'ワークシートモジュール
Private Sub SpinButton1_SpinDown()

 Dim dataA1 As String
 Dim dataA2 As String
 Dim dataB1 As String
 Dim dataB2 As String
 Dim myindx As Integer
 If Me.ListBox1.MultiSelect = fmMultiSelectMulti Then Exit Sub
 If Me.ListBox1.ListCount = 0 Or Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1 Then Exit Sub
 myindx = Me.ListBox1.ListIndex
 dataA = Me.ListBox1.List(myindx, 0)
 dataB = Me.ListBox1.List(myindx + 1, 0)
 Me.ListBox1.List(myindx) = dataB
 Me.ListBox1.List(myindx + 1) = dataA
 Me.ListBox1.ListIndex = myindx + 1
 DoEvents
End Sub

Private Sub SpinButton1_SpinUp()

 Dim dataA As String
 Dim dataB As String
 Dim myindx As Integer
 If Me.ListBox1.MultiSelect = fmMultiSelectMulti Then Exit Sub
 If Me.ListBox1.ListCount = 0 Or Me.ListBox1.ListIndex < 1 Then Exit Sub
 myindx = Me.ListBox1.ListIndex
 dataA = Me.ListBox1.List(myindx)
 dataB = Me.ListBox1.List(myindx - 1)
 Me.ListBox1.List(myindx - 1) = dataA
 Me.ListBox1.List(myindx) = dataB
 Me.ListBox1.ListIndex = myindx - 1
 DoEvents
End Sub

Private Sub ToggleButton1_Click()

 If Me.ToggleButton1.Value = True Then
     Me.ToggleButton1.Caption = "Multi"
     Me.ListBox1.MultiSelect = fmMultiSelectMulti
 Else
     Me.ToggleButton1.Caption = "Single"
     Me.ListBox1.MultiSelect = fmMultiSelectSingle
 End If
End Sub

'ThisWorkbookモジュール

Private Sub Workbook_Open()

 Dim objlb As Object
 Dim ws As Worksheet
  Set objlb = Worksheets("選択シート").OLEObjects("ListBox1").Object
  objlb.MultiSelect = fmMultiSelectMulti
  For Each ws In ThisWorkbook.Worksheets
   If ws.Name <> "選択シート" Then
      objlb.AddItem ws.Name
   End If
  Next ws
  Set objlb = Nothing
  Worksheets("選択シート").OLEObjects("ToggleButton1").Object.Value = True '追加部分
End Sub
（OK） 2020/04/14(火) 10:41

 ここまでシートに配置するActiveXコントロールの
 コードを書いておいてなんなのですが、私がもし
 同様のことを行うのなら、ユーザーフォームを使用
 します。

 ユーザーフォームなら、他のブックをアクティブに
 すれば、アクティブブックを操作できるからです。
（OK） 2020/04/14(火) 10:59

ワークシートモジュール
Private Sub SpinButton1_SpinDown()

 Dim dataA1 As String
 Dim dataA2 As String
 Dim dataB1 As String
 Dim dataB2 As String

 ↓でした。

ワークシートモジュール
Private Sub SpinButton1_SpinDown()

 Dim dataA As String
 Dim dataB As String
（OK） 2020/04/14(火) 14:41

コメント返信：

[ 一覧(最新更新順) ]

[[20200413195424]] 『VBAで選択したワークシートをPDF形式で保存したい』（マーミー） ページの最後に飛ぶ

[[20200413195424]]　『VBAで選択したワークシートをPDF形式で保存したい』（マーミー）　ページの最後に飛ぶ