Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : Excel 2010)
セル値のシートを連続印刷したい
投稿日時: 18/06/03 20:27:50
投稿者: m024240

いつもお世話になっています。
 
月別の出勤記録等が50支社程度から集まってきます。(ファイル名が違うだけで、同じ体裁のもの)
4月、5月、・・3月、・とシートが並んでいて、毎月、該当月の2ページ目だけを印刷し、まとめます。
これをVBAで自動化できないものかと、VBAで集約するだけのBOOKを考えています。
集約BOOKはSheet1のH16セルに「ターゲット月」をリストから選び、1つのフォルダ内にある
全てのBOOKを開いてターゲット月の2ページ目だけ印刷処理させたいと考えています。
そこで、ネットや参考本から、次のようなコードを作成しましたが、ターゲット月を設定する部分から
上手くいかなくて困っています。
(まだ、最後まで到達していないので、他BOOKまで行けるのかも分かりません)
修正箇所や、よりスムーズな動きへの改良の助言をお願いします。
 
標準モジュールに
------------------------------------------------------------------
Sub フォルダ内連続印刷()
 
Dim bkSrc As Workbook 'コピー元ワークブック
Dim folderPath As String '処理対象のフォルダパス
Dim itm As Object
Dim trgM As Variant 'ターゲット月
 
    Set trgM = Range("H16")
     
'Excelファイルが保存されているフォルダを選択
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False '複数選択しない
    .Title = "Excelファイルが保存されているフォルダを選択"
    If .Show = True Then
        folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納
    Else
        Exit Sub 'フォルダが選択されなかった場合は処理終了
    End If
End With
 
'ファイルの処理にFileSystemObjectオブジェクトを利用
With CreateObject("Scripting.FileSystemObject")
     
    '指定したフォルダ内のファイルを順番に処理
    For Each itm In .GetFolder(folderPath).Files
       
      '処理対象となるファイルの拡張子を指定
        Select Case LCase(.GetExtensionName(itm.Path))
        Case "xls", "xlsx", "xlsm", "csv"
          Set bkSrc = Application.Workbooks.Open(itm.Path) '元のワークブックを開く
          bkSrc.Sheets("trgM").PrintOut From:=2, To:=2, Copies:=1 'ターゲット月の2ページ目だけ印刷
          bkSrc.Close SaveChanges:=False 'コピー元のワークブックを変更せずに閉じる
        End Select
    Next
End With
End Sub
---------------------------------------------------------------------------------
 
 

回答
投稿日時: 18/06/03 23:25:29
投稿者: WinArrow
投稿者のウェブサイトに移動

取り敢えず、↓の3ヶ所を修正してみてください。
 
 
(1)1ヶ所目
>Dim trgM As Variant 'ターゲット月

Dim trgM As String 'ターゲット月
 
(2)2ヶ所目
> Set trgM = Range("H16")

    trgM = Range("H16").Value
但し、このままでは、アクティブなシートのH16セルになってしまうので
     trgM = Thisworkbook.Sheets("Sheet1").Range("H16").Value
のようにブック・シートで修飾した方が無難です。
ブック・シートは実情に併せて変更してください。
 
理由
Set命令はセルのアドレスを変数に格納するので、3ヶ所目のコードに無理なく対応するためには
「値」を取得しておいた方がよいです。
 
(3)3ヶ所目
> bkSrc.Sheets("trgM").PrintOut From:=2, To:=2, Copies:=1

       bkSrc.Sheets(trgM).PrintOut From:=2, To:=2, Copies:=1
  
理由
>"trgM"
「"」で括ると「trgM」という文字列になってしまい、trgMという名前のシートが存在する必要があります。
また、(2)で、trgMをオブジェクト変数にした場合
bkSrc.Sheets(●●)の●●の部分にオブジェクト変数を記述することはありえません。
(2)でどうしてもオブジェクトを使いたければ
bkSrc.Sheets(trgM.Value)
にする方法があります。
 
 
 

回答
投稿日時: 18/06/04 10:25:52
投稿者: mattuwan44

Sub フォルダ内連続印刷()
    Dim bkSrc As Workbook 'コピー元ワークブック
    Dim folderPath As String '処理対象のフォルダパス
    Dim itm As Object
    Dim trgM As String 'ターゲット月
 
    Set trgM = ThisWorkbook.Sheets("Sheet1").Range("H16").Text
 
    'Excelファイルが保存されているフォルダを選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False '複数選択しない
        .Title = "Excelファイルが保存されているフォルダを選択"
        If .Show = True Then
            folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納
        Else
            Exit Sub 'フォルダが選択されなかった場合は処理終了
        End If
    End With
 
    'ファイルの処理にFileSystemObjectオブジェクトを利用
    With CreateObject("Scripting.FileSystemObject")
        '指定したフォルダ内のファイルを順番に処理
        For Each itm In .GetFolder(folderPath).Files
            '処理対象となるファイルの拡張子を指定
            Select Case LCase(.GetExtensionName(itm))
                Case "xls", "xlsx", "xlsm", "csv"
                    Set bkSrc = Application.Workbooks.Open(itm.Path & "\" & itm.Name) '元のワークブックを開く
                    bkSrc.Sheets(trgM).PrintOut From:=2, To:=2, Copies:=1 'ターゲット月の2ページ目だけ印刷
                    bkSrc.Close SaveChanges:=False 'コピー元のワークブックを変更せずに閉じる
            End Select
        Next
    End With
End Sub

回答
投稿日時: 18/06/04 15:51:41
投稿者: WinArrow
投稿者のウェブサイトに移動

 mattuwan44 さんのフォロー
 
> Set trgM = ThisWorkbook.Sheets("Sheet1").Range("H16").Text

    trgM = ThisWorkbook.Sheets("Sheet1").Range("H16").Text
 
  ※Set 不要です。
 最後のプロパティは、".Text" なのか ".Value" なのか、実情に併せた方がよいでしょう。

投稿日時: 18/06/04 23:59:55
投稿者: m024240

WinArrow 様
mattuwan44 様
 
コメントありがとうございました。
ご指摘いただいた部分を修正して、無事に動かすことができました。
 
コードは、いろいろなところからの寄せ集め的なものなので、
十分に理解し切れていませんが、これから理解できるようにしていきたいです。
 
助かりました。
ありがとうございました。