前提・実現したいこと
VBAでフォームのリストボックス内にダイアログで選択したExcelファイル(複数)を表示させ。
①リストボックス内のExcelファイル(複数)をブック全体で印刷させたい。
(リストボックス内のファイルをループでアクティブにする方法orその他のやりかた)
②ファイル選択ボタン押下でダイアログボックスのカレントディレクトリを指定したい
③印刷した際に開いたファイルを開きっぱなしではなく自動で閉じるようにしたい
④リストボックス内のファイルを印刷した後にリストボックス内に選択したファイルの表示を残す方法
現在の状況
フォームのファイル選択ボタン押下でダイアログを開き、印刷したいExcelファイル(複数)を選択し、
リストボックスに選択したExcelファイル(複数)を表示させることはできましたが、
印刷ボタンでリストボックス内のExcelファイル(複数)を印刷しようとしたのですが、
複数印刷することができず、最初に選んだアクティブ(?)のExcelファイルだけが印刷できる状態です。(うまくいかなかったのでソースの記載なし)
ThisWorkBook
VBA
1Option Explicit 2 Sub Workbook_Open() 3 MainForm.Show 4End Sub
MainForm
VBA
1Option Explicit 2 'インスタンス生成 3 Dim CFileMgr As New FileMgr 4 '読み込みボタン押下時 5Private Sub btn_FileOpen_Click() 6 CFileMgr.OpenFile 7End Sub 8 '印刷ボタン押下時 9Private Sub btn_FilePrint_Click() 10 CFileMgr.OpenFile 11End Sub
GrobalDate
VBA
1Option Explicit 2'ユーザ定義型 3 Public Type FileData 4 FilePath As String 5 BookName As String 6 SheetName As String 7 End Type 8'グローバル変数定義 9Public ListInput() As FileData 'ファイルデータリスト 10Public ListIndex As Integer 'リスト内現在位置
FileMgr
VBA
1Option Explicit 2 Dim OpenFileName As Variant 'ファイル格納用 3 Dim Count As Interger 'ファイル数 4 Public isCansel As Boolean 'キャンセルフラグ 5'コンストラクタ 6 Private Sub Class_Initialize() 7 isCansel = False 8 Count = 0 9 ChDir (ThisWorkbook.Path) 10End Sub 11'ダイアログボックスから選択したファイルとパス取得 12Public Sub OpenFile() 13 Dim Target As Variant 14 Dim i As Integer 15 Dim isNew,isAddList As Boolean 16 isCansel = False 17 isAddList = False 18'選択ファイルを開いて名前を格納する 19 OpenFileName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xls?",MultiSelect:=True) 20'ファイル選択時の処理 21 If IsArray(OpenFileName) Then 22 For Each Target In OpenFileName 23'初回時 24 If Sgn(ListInput) = 0 Then 25'リストにファイル情報を格納 26 ReDim Preserve ListInput(Count) 27 ListInput(Count).BookName = dir(Target) 28 ListInput(Count).FilePath = Target 29'カウンタ加算 30 Count = Count + 1 31'リスト追加フラグ 32 isAddList = True 33Else 34'フラグ初期化 35 isNew = True 36'重複チェック 37 For i = 0 To UBound(ListInput) 38 If ListInput(i).BookName = dir(Target) Then 39 isNew = False 40 Exit For 41 End If 42 Next i 43'新規登録 44 If isNew Then 45'リストにファイル情報を格納 46 ReDim Preserve ListInput(Count) 47 ListInput(Count).BookName = dir(Target) 48 ListInput(Count).FilePath = Target 49'カウンタ加算 50 Count = Count + 1 51’リスト追加フラグオン 52 isAddList = True 53 End If 54 End If 55 Next Target 56 Else 57'キャンセル時 58 isCansel = True 59 Exit Sub 60 End If 61'新規追加時のみリスト登録処理 62 If isAddList Then SetListInput() 63End Sub 64'リストに登録 65Private Sub SetListInput() 66 Dim i As Long 67'リストボックスクリア 68 MainForm.BookInput.Clear 69'登録 70 For i = 0 To UBound(ListInput) 71 MainForm.BookInput.AddItem ListInput(i).BookName 72Next i 73End Sub 74
よろしくお願いいたします。
回答5件
あなたの回答
tips
プレビュー