質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.84%

  • VBA

    1562questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1335questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • マクロ

    201questions

    定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

VBAで複数のExcelファイルを印刷するマクロについて

解決済

回答 5

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 306
退会済みユーザー

退会済みユーザー

 前提・実現したいこと

VBAでフォームのリストボックス内にダイアログで選択したExcelファイル(複数)を表示させ。
①リストボックス内のExcelファイル(複数)をブック全体で印刷させたい。
(リストボックス内のファイルをループでアクティブにする方法orその他のやりかた)
②ファイル選択ボタン押下でダイアログボックスのカレントディレクトリを指定したい
③印刷した際に開いたファイルを開きっぱなしではなく自動で閉じるようにしたい
④リストボックス内のファイルを印刷した後にリストボックス内に選択したファイルの表示を残す方法

 現在の状況

フォームのファイル選択ボタン押下でダイアログを開き、印刷したいExcelファイル(複数)を選択し、
リストボックスに選択したExcelファイル(複数)を表示させることはできましたが、
印刷ボタンでリストボックス内のExcelファイル(複数)を印刷しようとしたのですが、
複数印刷することができず、最初に選んだアクティブ(?)のExcelファイルだけが印刷できる状態です。(うまくいかなかったのでソースの記載なし)

 ThisWorkBook

Option Explicit
  Sub Workbook_Open()
  MainForm.Show
End Sub

 MainForm

Option Explicit
  'インスタンス生成
  Dim CFileMgr As New FileMgr
  '読み込みボタン押下時
Private Sub btn_FileOpen_Click()
  CFileMgr.OpenFile
End Sub
  '印刷ボタン押下時
Private Sub btn_FilePrint_Click()
  CFileMgr.OpenFile
End Sub

 GrobalDate

Option Explicit
'ユーザ定義型
  Public Type FileData
    FilePath As String
    BookName As String
    SheetName As String
  End Type
'グローバル変数定義
Public ListInput() As FileData  'ファイルデータリスト
Public ListIndex As Integer     'リスト内現在位置

 FileMgr

Option Explicit
  Dim OpenFileName As Variant 'ファイル格納用
  Dim Count As Interger       'ファイル数
  Public isCansel As Boolean  'キャンセルフラグ
'コンストラクタ
  Private Sub Class_Initialize()
  isCansel = False
  Count = 0
  ChDir (ThisWorkbook.Path)
End Sub
'ダイアログボックスから選択したファイルとパス取得
Public Sub OpenFile()
  Dim Target As Variant
  Dim i As Integer
  Dim isNew,isAddList As Boolean
  isCansel = False
  isAddList = False
'選択ファイルを開いて名前を格納する
  OpenFileName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xls?",MultiSelect:=True)
'ファイル選択時の処理
  If IsArray(OpenFileName) Then
     For Each Target In OpenFileName
'初回時
  If Sgn(ListInput) = 0 Then
'リストにファイル情報を格納
  ReDim Preserve ListInput(Count)
  ListInput(Count).BookName = dir(Target)
  ListInput(Count).FilePath = Target
'カウンタ加算
  Count = Count + 1
'リスト追加フラグ
  isAddList = True
Else
'フラグ初期化
  isNew = True
'重複チェック
  For i = 0 To UBound(ListInput)
    If ListInput(i).BookName = dir(Target) Then
       isNew = False
       Exit For
     End If
    Next i
'新規登録
  If isNew Then
'リストにファイル情報を格納
  ReDim Preserve ListInput(Count)
  ListInput(Count).BookName = dir(Target)
  ListInput(Count).FilePath = Target
'カウンタ加算
  Count = Count + 1
’リスト追加フラグオン
  isAddList = True
     End If
    End If
   Next Target
  Else
'キャンセル時
  isCansel = True
  Exit Sub
 End If
'新規追加時のみリスト登録処理
  If isAddList Then SetListInput()
End Sub
'リストに登録
Private Sub SetListInput()
  Dim i As Long
'リストボックスクリア
  MainForm.BookInput.Clear
'登録
 For i = 0 To UBound(ListInput)
 MainForm.BookInput.AddItem ListInput(i).BookName
Next i
End Sub


よろしくお願いいたします。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • s8_chu

    2018/06/30 17:26 編集

    1つ質問なのですが、これはBootstrapについての質問なのですか?

    キャンセル

  • s8_chu

    2018/06/30 17:40

    退会しちゃうのか・・・。

    キャンセル

回答 5

checkベストアンサー

0

ユーザーフォームに依存するコードをクラスモジュールにする意味とか、複雑なコードにする意味が不明ですので、
カレントディレクトリの指定、リストボックスにダイアログで選択したファイル名の表示、
リストボックスに表示されているすべてのブック全体を印刷して閉じる、
というシンプルなコード例を提示しておきます。

Private Sub btn_FileOpen_Click()
    Dim OpenFileName As Variant, Target As Variant
    'カレントディレクトリを指定
    ChDrive "C"
    ChDir "C:\test"

    OpenFileName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xls?", _
                                               MultiSelect:=True)
    If IsArray(OpenFileName) Then
        With Me.BookInput
            .Clear
            'リストボックスにファイル名を表示
            For Each Target In OpenFileName
                .AddItem Dir(Target)
            Next Target
            'ファイルのあるフォルダーのパスをラベルに表示
            Me.lblPath.Caption = Replace(OpenFileName(1), .List(0, 0), "")
        End With
    Else
        MsgBox "キャンセルされました"
    End If

End Sub

Private Sub btn_FilePrint_Click()
    Dim wb As Workbook
    Dim Fn As Variant, i As Long
    Application.ScreenUpdating = False
    With Me.BookInput
        For i = 0 To .ListCount - 1
            Set wb = Workbooks.Open(Me.lblPath.Caption & .List(i, 0))
            wb.PrintOut 'ブック全体を印刷
            wb.Close
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
    Me.lblPath.Caption = ""
End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/06/19 12:35

    hatena19さん

    回答ありがとうございます。

    〉ユーザーフォームに依存するコードをクラ
    〉スモジュールにする意味とか、複雑なコー
    〉ドにする意味が不明ですので、
    ユーザーフォームに依存するコードをクラスモジュールに書いたのは、後々追加したい処理が出てきた時に分けておくと便利だと思ったからです。複雑なのは申し訳ありません特に意味はないです。

    回答して頂いたコードを試して実現したいことはできたのですが一点気になることがあるのですが、ファイルを複数選択した時に違うフォルダ内のファイルも同時に選択するにはどうすれば良いのでしょうか?
    例) AフォルダのA1ファイル、A2ファイル…
    BフォルダのB1ファイル、B2ファイル…
    を選択したい時

    よろしくお願い致します。

    キャンセル

0

なぜか問題ないソースは掲示され、うまく動かないソースの提示がないので、
どの部分ができないのかわかりませんが、
とりあえずブックを開いて全シートを印刷して閉じるファンクションをのせておきますの、
for each とかでリストの項目を回して下記のファンクションに投げればいいのではないでしょうか。

Function allprint(itm As String)
    Set procworkbook = Workbooks.Open(itm)
    sheetscnt = procworkbook.Worksheets.Count
    For i = 1 To sheetscnt
        procworkbook.Worksheets(i).PrintOut
    Next i
    procworkbook.Close
End Function

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/06/19 12:40

    shinobu_osakaさん

    回答ありがとうございます。
    ご指摘頂いた通りに上手くいかなかったソースも記載すれば良かったですね。

    Functionを使ったやりたかがあったんですね。
    勉強になります。
    試してみます。

    キャンセル

0

あ、サブフォルダも検索しちゃいますけど、
問題ないですかね?
あんまり難しく考えなくてもいいと思いますが。。。
一例です。

Option Explicit

'「File System Object」 を利用するので「Microsoft Scripting Runtime」を参照設定すること
Dim mobjFSO As FileSystemObject

Private Sub CommandButton1_Click()
    Dim i As Long
    Dim wb As Workbook
    Dim lb As MSForms.ListBox

    Set lb = Me.ListBox1
    For i = 0 To lb.ListCount - 1
        If lb.Selected(i) Then
            With Workbooks.Open(lb.List(i, 0))
                Application.StatusBar = .Name & "印刷中"
                'PrintOut           '←①ブック全体の印刷(ブックに対してPrintOutメソッド実行)
                .PrintPreview
                .Close False        '←③開いたブックを閉じる
            End With
        End If
    Next
    Application.StatusBar = False
End Sub

Private Sub UserForm_Initialize()
    Dim vList() As String
    Set mobjFSO = New FileSystemObject
    ReDim vList(0 To 1, 0 To 5000)

    With Me.ListBox1
        If GetFileList(vList) Then
            .List = WorksheetFunction.Transpose(vList)
        End If
        .ColumnCount = 2
        .ColumnWidths = "0"
        .MultiSelect = fmMultiSelectExtended
    End With
End Sub

Private Function GetFileList(ByRef pList() As String, _
                             Optional ByVal sFolderPath As String = "", _
                             Optional ByRef ix As Long = 0) As Boolean
    Dim oFile As File
    Dim oFolder As Folder
    Dim oSubFolder As Folder
    Dim i As Long
    Dim flg As Boolean

    If Len(sFolderPath) = 0 Then
        If GetFolderPath(sFolderPath) = False Then Exit Function
        flg = True
    End If

    Set oFolder = mobjFSO.GetFolder(sFolderPath)
    For Each oSubFolder In oFolder.SubFolders
        If GetFileList(pList, oSubFolder.Path, ix) = False Then GoTo ErrH
    Next

    For Each oFile In oFolder.Files
        If ix > UBound(pList, 2) Then GoTo ErrH
        If mobjFSO.GetExtensionName(oFile) = "xlsx" Or _
           mobjFSO.GetExtensionName(oFile) = "xls" Then
            pList(0, ix) = oFile.Path
            pList(1, ix) = oFile.Name
            Application.StatusBar = pList(1, ix)
            ix = ix + 1
        End If
    Next

    GetFileList = True
    If flg Then
        ReDim Preserve pList(0 To 1, 0 To ix - 1)
        Application.StatusBar = False
    End If
    Exit Function
ErrH:
    GetFileList = False
End Function

Private Function GetFolderPath(ByRef s As String) As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "D:\"   '←②初期表示ディレクトリ指定
        .AllowMultiSelect = False
        .Title = "フォルダの選択"
        If .Show Then
            s = .SelectedItems(1)
            GetFolderPath = True
        End If
    End With
End Function

④は特に何もしなくても選択はそのままです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/06/20 14:56

    mattuwanさん
    回答ありがとうございます。
    試して見ました。
    親フォルダ内、または子フォルダ内のExcelファイルを選択するやり方はできました。

    親フォルダがあり
    子フォルダAフォルダ、Bフォルダ、Cフォルダ…があった際にCフォルダのファイルを除くAフォルダのファイルCフォルダのファイルを選択するのはどういった方法で選択すれば良いでしょうか?

    キャンセル

0

ああああ!
一つ大事なことを書き忘れてました。

上記のコードを実行するとき、
ユーザーフォームをモーダルで表示すると、
プレビューが表示されたとき、どこも触れなくて固まったような状態になります。
この時は、タスクバーから該当ブックを閉じるようにしていただくと、
プログラムが先に進みます。

よろしくお願いします。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

親フォルダがあり
子フォルダAフォルダ、Bフォルダ、Cフォルダ…があった際にCフォルダのファイルを除くAフォルダのファイルCフォルダのファイルを選択するのはどういった方法で選択すれば良いでしょうか?

.AllowMultiSelect = False ←ここをTrueにしたら複数選択できますので、
返り値を配列で返すように関数を変更したらいいと思います。

http://stabucky.com/wp/archives/1507
↑この辺を見て直せそうでしょうか?

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.84%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

  • 解決済

    Excel VBA のe-learningに関する質問

    Windows7(32ビット) の環境でExcel2010 VBAを使って下記のような e-learningの問題を作りたいと思っていますので、どなたかお分かりになる方、 ご教

  • 受付中

    マクロ実行中のセル入力について

    excelvbaでマクロ実行中に セルに入力をするとマクロがとまってしまいます。 マクロの内容としては、セルの順番にアクティベートにして、 そのセルに入力を出来るようにしたい

  • 解決済

    ExcelVBAで複数領域の選択

    ExcelVBAでマクロを作っています。 長方形の範囲を指定した際、その選択範囲を横一列毎の複数選択範囲に分割する必要がありますが、 方法がわかりません。 小さい範囲なら

  • 解決済

    別ファイルのセル 操作

    別ファイルのセルの操作ができず、困っています。 ファイルAからファイルBを開き、ファイルBを閉じるときに、ファイルAに値を反映させて、ファイルBを閉じる処理を行いたいと思ってお

  • 解決済

    Excel VBA 特定範囲の重複している列に空白を設定する

    お世話になっております EXCELのVBAや関数を使用し、下記の様な表を編集したいと思っております。 置換前 グループ 項目1* 項目2 項目3 項目X 項目Y

  • 受付中

    シート上に配置したオプションボタンを他のPCでは認識してくれない

    お世話になります。 win7 excel2010 環境でシート場にフォームコントロールのオプションボタンをシート上に配置して望むようなソフトができあがりました。 しかし、同ソフトを

  • 受付中

    VBAでフィルターをかけて、検出対象を別シートへコピーしたい

    前提・実現したいこと ログを確認するVBA シート1 ログ全文 シート2 単語1 シート3 単語2 シート4 単語3 ①ログ全文シートに貼り付けられたログ(A列のみ、空白行

  • 解決済

    データ挿入、データ削除をボタンで行う。

    VBA初心者です。 現在、スコア(球技)の集計をしたいと思い 表にファイル内のデータを指定の位置に挿入する。というものを実現したいのですが 色々試したのですが、なかなかうまくいきま

同じタグがついた質問を見る

  • VBA

    1562questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1335questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • マクロ

    201questions

    定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。