• ベストアンサー

エクセル・大量印刷の方法

ネットワーク上にあるフォルダの中の全ブックの全シートを印刷します。 現在は、ＶＢＡで１つずつブックを開き、印刷して閉じるというのを繰り返しています。 しかし、ブックのサイズが大きいのでとても時間がかかっています。 ブックを開くのにとても時間がかかるようです。 エクセルはブックを開かなくても、エクスプローラで該当のブックを選び、右クリック⇒印刷で印刷できます。 これは確かにブックを開かないので早いです。 ですが、select状態のシートしか印刷されません。 一応ブック作成時に全シート選択状態にしてあるので、エクスプローラから右クリック⇒印刷でもいいのですが、だれかが開いたりしてselectが解除されていても分からないのが欠点です。 そこでまた別の方法と思い、１つのブックにＶＢＡで全ブックの全シートを１シートずつリンク貼り付け⇒印刷とやろうかと思いました。 （リンク貼り付けの式をＶＢＡで記述しようという意味です） でもブックごとのシートの数はバラバラ、名前もバラバラです。 シート名の取得もやはりブックを開かないと難しいですよね。 と言う訳で行き詰っています。 なるべく短時間で全シートを印刷するなにかいい方法はないでしょうか？ お知恵を貸して下さい。 現状の印刷コードを書いておきます。 Sub 印刷() Dim fn Dim Mydir Dim FSO As Object Dim FolderObject, fc As Integer, Afc As Integer Application.ScreenUpdating = False pflg2 = False 　　If MsgBox("印刷を開始します。", vbOKCancel) = vbCancel Then Exit Sub 　　Mydir = Sheets(1).Range("B7") 　　Set FSO = CreateObject("Scripting.FileSystemObject") 　　Set FolderObject = FSO.GetFolder(Mydir) 　　　　Afc = FolderObject.Files.Count 　　Set FSO = Nothing 　　'***** ユーザーフォームを表示する 　　Load UserForm3 　　UserForm3.Show 0 　　DoEvents 　　 　　ChDir Mydir 　　fn = Dir(Mydir & "\*.xls") 　　fc = 1 　　 　　Do 　　　　'***** プログレスバー 　　　　If pflg Then GoTo errHandler 　　　　UserForm3.ProgressBar3.Value = fc / Afc * 100 　　　　UserForm3.Caption = "印刷データ転送中…" & fc & "/" & Afc 　　　　DoEvents 　　　　 　　　　Workbooks.Open (Mydir & "\" & fn) 　　　　ActiveWorkbook.PrintOut Copies:=1, Collate:=True 　　　　ActiveWorkbook.Close False 　　　　 　　　　fn = Dir() 　　　　fc = fc + 1 　　Loop Until fn = "" 　　 　　UserForm3.CommandButton1.Caption = "完了" 　　pflg2 = True 　　DoEvents 　　 　　Exit Sub 　　 errHandler: 　　Unload UserForm3 　 End Sub

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

ExcelAutoPrint　なんてどうでしょう。 フリーツールです。

-yellowtail-
質問者

お礼

ありがとうございます。 フリーツールはちょっと難しいデス。（全員にインストールするとなると…という点で） 見てみたのですが、ファイルを一つずつＤ＆Ｄと言うのはちょっと大変かなと言う気もします。

その他の回答 (4)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.5

#3お礼で反応していただいてありがとうございます。 私の力点は ＞印刷出力結果をファイル（ディスク）に一旦吐き出す ということにあったのですが。 ファイルー印刷ーファイルへ出力。PrintToFile:=True, ーー お礼では、周辺（これは時間節約にはあまりならないのは判っている）ばかり注目されて残念。

-yellowtail-
質問者

お礼

申し訳ありませんでした。 その後、色々やってみた結果、どうがんばっても印刷時には一度エクセルでファイルを開くということが分かりました。 （右クリックでも開いていました。誤認識でした。） ありがとうございました。 お礼が遅れてすみませんでした。

回答No.4

ANo.1ですが フリーツール使用禁止＆VBAで作る気力があるなら、 こちらはどうですか？ http://oshiete1.goo.ne.jp/qa3141142.html

-yellowtail-
質問者

お礼

これって、フリーツールの中身もこんな感じなのでしょうか？ だとすると最初のアプリも複数ファイルを一挙にＤ＆Ｄでも大丈夫だったかも…。すみません。 ただネックはやはりブックを開いている点で、速度的には変わりませんでした。 でも同じようなことする方いたんですね。検索が不十分で申し訳ないです。 もう少し模索してみようと思います。ありがとうございました！！

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

多数ファイル多量の印刷の経験が無いが、ちょっと思いついた。 エクセルには印刷出力結果をファイル（ディスク）に一旦吐き出す機能がある。これで出力ファイルを専用プリンタや他の業務処理と同時並行処理で紙に打ち出すのは、どうですか。 ＞フォルダの中の全ブックの全シート・・ FSOで指定フォルダの各ファイル（.ｘｌｓ）を捉え、エクセルのブックを印刷する（注１）ことだけにして、プログレスバー表示（注２）やフォーム利用（注３）をやめては差し障りありますか。 （注１） http://pc-club.web.infoseek.co.jp/pc_materials/exl_new/exl_new11_5.htm ブックの印刷 （注２）必須ですか （注３）省略できませんか （注１）－（３）でどれだけ時間短縮になるか分からないが、介入・確認を全て省けるような気がして、全自動でやればよいことのような気がした。

-yellowtail-
質問者

お礼

ありがとうございます。 フォームや進捗はあまりに時間がかかるので、目視で体感速度を下げようとしているだけなので、なくしても問題ないです。 もともとはなかったのですが、どうにも時間がかかって（私が）いらーっとしたので進捗がわかるように入れました。 ただ、このコードのあとちょっとの短縮はあまり考えてなく、もっと劇的に速くならないかな…と思っています。 ブックを開くのが元凶に思えて仕方ないのです。それをクリアしたいのですが、どうにも…。

回答No.2

こんなのもあります。（私は使っていませんので無責任のようですが） 会社用だと問題があるかも知れませんが。 http://www.vector.co.jp/soft/win95/writing/se328342.html http://www.vector.co.jp/soft/win95/util/se351544.html

-yellowtail-
質問者

お礼

これは個人的にはすごく便利！と思いました。 こういうものを自分で作れると業務がすごくやりやすくなりそうです。 上の方のお礼を書いてから気づいたのですが、ネットワーク上にインストールしてあげれば良いのかも？と思いました。 検討してみようと思います。 ありがとうございました！フリーツールは盲点でした。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • エクセルVBAで読み取りパスワード回避

    エクセル2010です。 以下のコードで任意のフォルダ内のエクセルBOOKから所定のデータを取得できます。 しかし、指定フォルダ内に読み取りパスワードが設定されたものがあると、開くことができずに止まってしまいます。 読み取りパスワードが同一で、事前に分かっていればコードにPassword:="AAAABBBB"　などと書き入れればいいと思うのですが、事前にはわかりませんし、パスワードもそれぞれ異なります。 そこで、開けなかった場合には、そのBOOKを飛ばしてすすみ、別シートに飛ばしたBOOK名を記録しておきたいのです。 （BOOK作成者にあとからパスワードを聞くため） しかし、残念ながらどのように書けばいいのか思いつきません。 ご指導いただければ幸いです。 Sub TEST001() 　　Dim wb(1) As Workbook 　　Dim ws(1) As Worksheet 　　Dim myFdr As String, fn As String 　　Dim i As Long 　　With Application.FileDialog(msoFileDialogFolderPicker) 'フォルダ指定 　　　　If .Show = True Then 　　　　　　 myFdr = .SelectedItems(1) 　　　　Else 　　　　　　Exit Sub 　　　　End If 　　End With 　　Application.ScreenUpdating = False '画面更新を一時停止 　　Set wb(0) = ThisWorkbook 'このコピー先ブックをwb(0)とする。 　　Set ws(0) = wb(0).Sheets(1) 'wb(0)の１枚目のシートをws(0)とする。 　　fn = Dir(myFdr & "\*.xls*") 'フォルダ内のExcelブックを検索 　　Do Until fn = Empty '全て検索 　　　　Application.EnableEvents = False 　　　　Set wb(1) = Workbooks.Open(myFdr & "\" & fn, UpdateLinks:=False, ReadOnly:=True) 'そのブックを開きwb(1)とする。 　　　　Set ws(1) = wb(1).Worksheets(1) 　　　　i = i + 1 　　　　ws(0).Cells(i, "A").Value = ws(1).Range("B2") 'ws(0)に転記 　　　　ws(0).Cells(i, "B").Value = wb(1).Name 　　　　ws(0).Cells(i, "C").Value = ws(1).Name 　　　　wb(1).Close (False) '保存せず閉じる 　　　　Application.EnableEvents = True 　　　　fn = Dir 'フォルダ内の次のExcelブックを検索 　　Loop '繰り返す 　　Application.ScreenUpdating = True '画面更新停止を解除 　　MsgBox i & "個取得" End Sub

  • シートのセルの数値がゼロ0のときは、印刷しない方法は

    Windows7 Excel2007でマクロ作成の初心者です。 シート数が20枚のブックがあります。セルＨ3には数値が入っています。 このセルが空欄もしくは数値0のときは、そのシートの印刷をやめたいです。 現在、印刷は以下のコードで実行しています。印刷を省略するにはどうしたらよろしいでしょうか。 Sub シートの印刷() Application.ScreenUpdating = False Dim i As Integer For i = 1 To Worksheets.Count - 9 Worksheets(i).Activate ActiveSheet.PageSetup.PrintArea = "$B$46:$U$89" ActiveWindow.SelectedSheets.PrintOut Next i Worksheets(1).Activate Application.ScreenUpdating = True End Sub

  • VBAでアクティブなファイルを参照して、ファイル一覧作成（サブフォルダ含む）

    VBAでアクティブなファイルのフォルダ（サブフォルダを含む）のファイル一覧を 作成したいと思っています。 以下のサイトを参考にして、パス、ファイル名を落とすまではできました。 http://okwave.jp/qa3544575.html === Sub test() Application.ScreenUpdating = False Sheet1.Cells.Clear Sheet1.Cells(1, 1) = "パス" Sheet1.Cells(1, 2) = "ファイル名" files "d:\", 2 Application.ScreenUpdating = True End Sub Sub files(path As String, ByRef row As Long) DoEvents Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim f As Object For Each f In fso.GetFolder(path).files Sheet1.Cells(row, 1) = path Sheet1.Cells(row, 2) = f.Name row = row + 1 Next For Each f In fso.GetFolder(path).SubFolders files f.path, row Next Set fso = Nothing End Sub === >files "d:\" の箇所を修正して、アクティブなブックを参照しようとしてみたのですが、 なかなか上手くいきません。 また、できれば　*.xls　などファイルの種類を指定したいのです。 filesearchを使用して組んだ時は 「AAA = ActiveWorkbook.path」「Filetype　～　」 などでそれらの指定ができたのですが、上記に応用する事ができません。 どなたかご教示頂けますよう、よろしくお願いいたしますm(_ _)m

  • エクセルのデータを定型用紙に印刷　

    エクセルのデータシートの各行（１件づつ）を 一枚づつ定型の見積り書に印刷しようと思います。 sheet1が定型の見積書 sheet2がデータシートです。 sheet1のセル(12,3)にsheet2のセル(2,4),(3,4),(4,4) を印刷するには Sub 見積書印刷() Dim i As Long With Worksheets("sheet1") For i = 2 To 4 .Cells(12, 3).Value = Worksheets("sheet2").Cells(i, 4) .PrintOut Next i End With End Sub で、　できました。 データがsheet2でなく他のBOOKのsheetの場合 どのような式になるか 教えていただけませんか、お願いします。

  • Excel VBA　ブックが閉じれない

    Excel2016を使用してVBAを使用しています。 VBA初心者ですが、よろしくお願いします。 質問内容は以下になります。 EXCEL起動と同時にUserFormを表示させ、UserForm上のコマンドボタンから ダイアログボックスを表示し、他ブックを開く処理なのですが、 他ブックを開くまでは問題ないのですが、他ブックが閉じれない状態になります。 Private Sub Workbook_Open() UserForm1.Show End Sub Private Sub UserForm_Initialize() 　各種処理 End Sub Private Sub CommandButton1_Click() Dim OpenFileName As String SetCurrentDirectory (Worksheets(1).Cells(11, 3)) OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") Workbooks.Open OpenFileName End Sub UserFormを閉じると開いたブックも閉じることが可能です。 タスクマネージャーから強制的に終了しようとすると、以下メッセージが出ます。 ”開いているダイアログボックスがあるため、Microsoft Excel を終了できません。[OK]をクリックしてから、Microsoft Excelに切り替えてダイアログを閉じて下さい。" UserFormを閉じないで他ブックを閉じるには、どうすれば宜しいでしょうか。 申し訳ございませんがご教授下さい、よろしくお願いいたします。

  • エクセルにフォルダにある画像を貼付&整列する方法

    下記にあるマクロより、 選択したフォルダ内の画像ファイル（jpgファイル）すべてをA列に挿入、 B列にA列のファイル名の書き込みは出来ましたが、、、 この画像ファイルをファイル名ごとに整列する方法をお教え願います。 目的は、画像を横に並べ写真を比較したいです。 （例） 頭に「1」が付くファイル名・・・A列 頭に「2」が付くファイル名・・・C列 頭に「3」が付くファイル名・・・E列 よろしくお願いします。 （マクロ） Sub InsertPictures() 　Dim i As Integer 　Dim myDir As String 　Const myHeight = 200 '行の高さ。0-409を指定。写真のサイズがこれで調整される。 　Const myWidth = 50 '列の幅。0 - 255を指定。 　Dim myFName As String 　 　myDir = Application.GetOpenFilename(FileFilter:="すべての図(*.jpg),*.jpg") 　If myDir = "False" Then Exit Sub 　myDir = Left(myDir, Len(myDir) - Len(Dir(myDir))) 　 　Application.ScreenUpdating = False 　　ActiveSheet.DrawingObjects.Delete 　　Columns(2).ClearContents 　　Rows.AutoFit 　　 　　i = 1 　　myFName = Dir(myDir & "*.jpg") 　 　　Do While myFName <> "" 　　　With Cells(i, 1) 　　　　.Activate 　　　　.RowHeight = myHeight 　　　End With 　　　With ActiveSheet 　　　　.Pictures.Insert myDir & myFName 　　　　With .Shapes(i) 　　　　　.LockAspectRatio = msoTrue 　　　　　.Height = myHeight 　　　　End With 　　　End With 　　　Cells(i, 2).Value = myFName 　　　myFName = Dir 　　　i = i + 1 　　Loop 　　Columns(1).ColumnWidth = myWidth 　　Columns(2).AutoFit 　Application.ScreenUpdating = True End Sub

  • VBAのDoEventsが上手く動きません

    お世話になります。 ExcelのVBAで印刷処理をしているのですが、印刷枚数が多いのでDoEventsイベントを入れ、印刷中断処理を行いたいのですが、上手くできません。 印刷中ダイアログが表示されるのが原因なのでしょうか？それともコードの書き方が悪いのでしょうか？よろしくお願いします。 コードは以下のとおりです。 ************************************************ Public Can_flg As Boolean ************************************************ Private Sub CommandButton1_Click() 　　Can_flg = True End Sub ************************************************ Private Sub UserForm_Activate() 　　Dim ms As String 　　Dim j As integer 　　Can_flg = False 　　For j = 1 To 31 　　　DoEvents 　　　If Can_flg = True Then 　　　　　ms = MsgBox("印刷を中止します。", vbOKCancel) 　　　　　　　If ms = vbOK Then 　　　　　　　　Exit For 　　　　　　　Else 　　　　　　　　Can_flg = False 　　　　　　　End If 　　　End If 　　　Me.Label1.Caption = "印刷中です… (" & j & "/" & i & "ページ)" 　　　Sheets("テスト").PrintOut 　　Next j 　　Unload Me End Sub

  • 複数のCSVファイルを一つのブックに

    エクセルvbaの達人の皆様、どうか助けてください。 フォルダ内の複数のCSVファイルを一つのブックにシートを分けて取り込むvbaが知りたいです。問題は、 ・複数のcsvを一気に取り組みたい ・一つのブックに、csvファイル別にシートを分けたい ・文字化けを何とかしたい！！（文字コードをutf8にしたい） この3つをクリアすることですが、、 ネットで調べてみたところ、あるページに載っている以下のマクロを試してみたのですが、やはり文字化けしてしまいます。文字コードの設定をどこかで指定しなければならないと思いますが、どう改良すればよろしいでしょうか。（ちなみに、VBAは全くの初心者です） Sub test() Dim myObj As Object Dim myDir As String Dim myFileName As String Dim myc As Long Application.ScreenUpdating = False Set myObj = CreateObject("Shell.Application"). _ BrowseForFolder(0, "取り込むフォルダを選択してください", 0) If myObj Is Nothing Then Exit Sub myDir = myObj.Items.Item.Path If Right(myDir, 1) <> "\" Then myDir = myDir & "\" 'フォルダ内のExcelファイルを確認 myFileName = Dir(myDir & "*.csv") myc = 0 Do While myFileName <> "" Workbooks.Open (myDir & myFileName) myc = myc + 1 Workbooks(myFileName).Worksheets(1).Move ThisWorkbook.Worksheets(1) myFileName = Dir() Loop If myc = 0 Then MsgBox "CSVファイルがありません。" End If Application.ScreenUpdating = True End Sub （上記のマクロはhttp://www.excel.studio-kazu.jp/kw/20110705155353.html#commentから引用しました。）

  • excelのタスクバーアイコンが・・・

    どうも、お世話になります。mmc820です。 現在、VB上でexcelを操作するプログラムを作成しているのですが、excelを開いてフォームをアクティブ(前面)にしたときにタスクバーのexcelのアイコンが点滅してしまいます。VBで動かすと問題ないのですが、コンパイルして.EXEで実行するとこの現象が起きます。処理自体には影響は無いのですが、このままではユーザーが誤ってエクセルを閉じてしまう可能性がある（途中で閉じてしまうと当然処理が出来なくなります)ので何とかしたいと思っています。コードは以下の通りです。稚拙なコーディングですが・・・。 Dim Fn As String 'ファイルを開く With Form1.CommonDialog1 On Error GoTo ErrHandler2 .CancelError = True .Flags = cdlOFNFileMustExist .ShowOpen End With Fn = CommonDialog1.FileName Workbooks.Open Fn Text1.Text = Fn 'Debug.Print Fn cmdstart.Enabled = True ActiveWorkbook.Application.Visible = True ActiveWorkbook.Activate Application.ScreenUpdating = True Form1.SetFocus '実行画面を前面に表示 DoEvents ErrHandler2: ・・・いかがでしょうか？原因・解決法がおわかりの方、アドバイスいただければ幸いです。よろしくお願いします。

  • Excel　ホルダ内のCSVにMacroを実行

    Excel VBA 初心者です。指定ホルダ内の全てのCSVにMacroを実行したいのですがうまくいきません。 対象データは指定ホルダ内の全CSVファイル。 算出条件がBook内にありますが（セル番地の数値を読むようにしてあります）、以下のMacroのCSV処理をすると算出条件が見つからなくてストップしてしまいます。（Book内のデータに実行した場合は問題ないです） ※「 'CSVに対する処理 ActiveなBookとして処理します。」の部分に処理用のMacroをCallしています。 上記の問題の解決として Ａ案 (1)作業用のBookにCSVのデータを[Sheet1]呼びだす→(2)Macroを実行→(3)保存 →(4)[Sheet1］のDataClear→(1)に戻り指定ホルダ内のファイルがなくなるまで繰り返す。 Ｂ案 以下のMacroにコードを付加してBook内の算出条件を読み込ませる。 と考えましたが、初心者故の未熟で解決できません。どなたか、助けてください。 何卒よろしくお願いいたします。 Sub Macro() Dim FSO, FDC, FL Dim FPath As String, Opath As String Dim i As Long Set FSO = CreateObject("Scripting.FileSystemObject") 'Filesystemobjectを使用する FPath = "E:\test\" '入力フォルダ Opath = "E:\test\ttt\" '出力フォルダ Set FDC = FSO.getfolder(FPath).Files 'パスのファイルコレクションを取得 For Each FL In FDC If UCase(FSO.GetExtensionName(FL)) = "CSV" Then '拡張子がCSVだったら Workbooks.Open FL 'Openする ' 'CSVに対する処理 ActiveなBookとして処理します。 ' Application.DisplayAlerts = False '保存しますかのメッセージを止める ActiveWorkbook.SaveAs Opath & "R" & FL.Name '名前を付けて保存 ActiveWorkbook.Close 'Closeする Application.DisplayAlerts = True 'メッセージ出力をもとに戻す End If Next End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する