[[20070117130924]] 『フォルダの中にある複数のエクセルを一度に印刷し』(石田) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『フォルダの中にある複数のエクセルを一度に印刷したいのです。』(石田)

共有のネットワークで使っている"3階"というフォルダの中に、石田計画書.xls、井上計画書.xls、上田計画書.xls、江藤計画書.xls、・・・・和田計画書.xlsというエクセルをいれています。エクセルの数は40個ほどです。
○○計画書.xlsの中には、「メインメニュー」というシートと、「計画書」というシートの2つのシートがあります。
これらの"3階"というフォルダの中にある40個ほどのすべてのエクセル○○計画書.xlsの「計画書」のシートを一度に印刷をする方法はありますでしょうか。
(できれば、自動で実行し、その間、PCから離れて、別の作業を行いたいので、ひとつのエクセルが立ち上がり→プリントアウト→保存しますか?→いいえ→エクセルを閉じる・・という部分の いいえ の人的な作業をさけたいのです。)
ご教示よろしくお願いいたします。(石田)


 ネット上にツールがあると思いますが、
 VBAで自作も可能です。

 Dir関数でフォルダ内のブックを取得し、
 ブックを開きシートを印刷、ブックを閉じる、
 をループさせることになると思います。
 (MARBIN)

 フォルダ内のファイル一覧は↓が参考になります。

http://www.excel.studio-kazu.jp/mag2/backnumber/mm20041012.html

 これはファイル名をセルに転記していますが、セルに転記する代わりに
 ファイル(ブック)を開いて、となります。
 (MARBIN)

MARBINさん
ご指導ありがとうございます。ご指示のあった、リンク先確認してまいりました。
ただ、なにぶん、勉強不足の素人であるため、具体的に下記のマクロのどこをどのように変更すれば、ファイルを開いて⇒指定のシートに移動して⇒プリントアウト⇒保存せずに終了。となるのか、分らないのです。ご教授いただけないでしょうか。なにとぞよろしくお願い致します。

 Sub FileListProc()
 ' ファイルの一覧を作成する
 Dim r As Integer, c As Integer
 Dim curpath As String, opt As String
     curpath = Selection.Value
     opt = Selection.Offset(0, 1).Value
     If Len(curpath) > 1 Then
         r = Selection.Row
         c = Selection.Column
         CurFileList r, c, curpath, opt
     Else
         MsgBox "フォルダのパスを入力したセルを選択してください。" & _
         vbCrLf & "例) C:\Documents and Settings\kazu\My Documents"
     End If
 End Sub

 Sub CurFileList(r, c, cur, opt)
 ' 指定されたパスのファイル一覧を取得
 Dim cur2 As String, myfile As String
     If Right(cur, 1) <> "\" Then
         cur = cur & "\"            ' パスの最後に\がない場合の対策
     End If
     cur2 = cur
     If Len(opt) <> 0 Then
         cur2 = cur2 & "*." & opt   ' suffix の指定
     End If
     myfile = Dir(cur2, vbNormal)   ' ←ポイント1
     r = r + 1
     Do While myfile <> Empty
         Cells(r, c).Value = myfile
         Cells(r, c + 1).Value = FileDateTime(cur & myfile) 'ファイルの更新日付
         r = r + 1
         myfile = Dir()             ' ←ポイント2
     Loop
 End Sub

Sub FileListProc2()

 ' いつも決まったフォルダの一覧をいくつも作成する場合の例
 '    CurFileList 101, 1, "C:\Documents and Settings\kazu\My Documents", "xls"
 '    CurFileList 2, 1, "C:\Windows", ""
 End Sub

(石田)


 >共有のネットワークで使っている"3階"というフォルダの中

 見落としてました。
 印刷時に他の方がフォルダ内のブックを開いている可能性はありますか? 
 もし他の方がブックを開いていると、ブックを開くときにエラーになる
 可能性があります。

 また、このフォルダは移動する可能性はありますか?
 もし、移動しないのなら、セルからフォルダのパスを取得しないで、
 定数として指定することも出来ます。

 指定フォルダ内のエクセルブックのみを取得すしセルに転記するサンプルです。

 Sub test()
  Const fol As String = "D:\marbin" 'フォルダを定数として指定
  Dim f As String
  Dim cnt As Integer
    f = Dir(fol & "\*.xls") '指定フォルダ内のエクセルブック取得
    Do While f <> "" 'ブックがなくなるまで
     cnt = cnt + 1 'カウントアップ
     Worksheets(1).Range("A" & cnt).Value = f 'セルに取得したブック名を転記
     f = Dir() 
    Loop
 End Sub

 また、
 Workbooks.Open(ブックのフルパス) '上の例では fol & "\" & f がフルパス
 でブックを開くことが出来ます。

 これを
 Set wb = Workbooks.Open(ブックのフルパス)
 とすると、変数に格納されたブックを処理できます。

 シートの指定は
 Set ws = wb.Sheets("計画書")
 などとします。
 ws.PrintOut
 でシートを印刷します。

 次は、
 wb.Close
 で開いたブックを閉じます。

 まとめると、こんな感じです。

 Sub test2()
  Const fol As String = "\\Neccomputer\D\marbin"
  Dim f As String
  Dim cnt As Integer
  Dim wb as Workbook
    f = Dir(fol & "\*.xls")
    Do While f <> ""
     set wb = Workbooks.Open(fol & "\" & f)
     wb.Sheets("計画書").PrinOut
     wb.close
     f = Dir() 
    Loop
   set wb = Nothing
 End Sub
 (MARBIN)

パスに偽りあり、でした。

 D\ → D:\

 でした。
 (MARBIN)

MARBINさん
ご指導ありがとうございます。

@このマクロを実行する時には、そのフォルダのなかのプログラムは誰も使用しない状況にしようと思っています。また、基本的にはフォルダの移動はありません。

Aご作成いただきました、マクロを

\\Fssvr\書棚\c1-3分院リハビリ科\リハ計画・サマリー・患者管理\リハ計画書(リハ)
上記を記載したセルの上で実行したところ、

f = Dir(fol & "\*.xls") の部分で、「「実行時エラー'52':ファイル名または番号が不適切です」」とのえらメッセージが出ました。なにか問題なのでしょうか?
ご指導お願い致します。

Sub Macro2()
'
' Macro2 Macro
' マクロ記録日 : 2007/1/17 ユーザー名 : toriika
'

  Const fol As String = "\\Neccomputer\D:\marbin"
  Dim f As String
  Dim cnt As Integer
  Dim wb As Workbook
    f = Dir(fol & "\*.xls")
    Do While f <> ""
     Set wb = Workbooks.Open(fol & "\" & f)
     wb.Sheets("計画書").PrinOut
     wb.Close
     f = Dir()
    Loop
   Set wb = Nothing
 End Sub

(石田)


 >Const fol As String = "\\Neccomputer\D:\marbin"
 ここ、私のPCのパスのまんまですが・・・。
 石田さんが実際に実行されたコードをアップしてみてください。
 (MARBIN)


 意味が分かりました。

 私が提示したコードは、セルの値を参照しません。

 >Const fol As String = "\\Neccomputer\D:\marbin"

 ↓のように書き換えてみてください。

 Const fol As String = "\\Fssvr\書棚\c1-3分院リハビリ科\リハ計画・サマリー・患者管理\リハ計画書(リハ)"
 (MARBIN)

 補足です。
 ネットワーク越しの作業になりますので、印刷開始まで
 若干時間がかかるかもしれません。
 (MARBIN)

ご指導ありがとうございます。
Sub Macro2() ' ' Macro2 Macro ' マクロ記録日 : 2007/1/17 ユーザー名 : toriika '

  Const fol As String = "\\Fssvr\書棚\c1-3分院リハビリ科\リハ計画・サマリー・患者管理\リハ計画書(リハ)"
  Dim f As String
  Dim cnt As Integer
  Dim wb As Workbook
    f = Dir(fol & "\*.xls")
    Do While f <> ""
     Set wb = Workbooks.Open(fol & "\" & f)
     wb.Sheets("計画書").PrinOut
     wb.Close
     f = Dir()
    Loop
   Set wb = Nothing
 End Sub

で実行いたしましたところ、「実行時エラー’438’:オブジェクトはこのプロパティまたはメソッドをサポートしていません」とのエラーメッセージ。ディバックすると「 wb.Sheets("計画書").PrinOut」の部分で黄色の強調されました。
なにか問題なのでしょうか?ご指導お願い致します。

見よう見まねで、「wb.Sheets("計画書").PrinOut」の部分を⇒「Sheets("計画書").Select

    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True」との変更で、動かすことができました。
ただ、@エクセルが開いて⇒Aプリントアウト⇒B保存せずに終了(選択肢として「いいえ」を選択)という、Bの部分が手動になりました。MARBINさんのコードではこの部分は省略可能なのでしょうか?

以上2点についてご指導いただいてもよろしいでしょうか。
よろしくお願いいたします(石田)

  
  


 プリンを出してました・・・。
 PrinOut
 ↓
 PrintOut
 と修正してください。
 昨日から凡ミスばかり・・・。
 失礼しました。
 (MARBIN)

MARBINさんご指導ありがとうございました。
本当におんぶにだっこですみませんでした。
今後ともご指導お願いいたします。m(_ _)m
ちなみに、
@エクセルが開いて⇒
Aプリントアウト⇒
B保存せずに終了(選択肢として「いいえ」を選択しなければエクセルが閉じない)
・・・という
Bの部分を自動で済ますことは難しいものでしょうか??(石田)

 おそらく、
 シートで
 Now
 などの揮発性関数を使っているか、
 マクロでブック起動時にセルを操作する
 作業を行っているのでしょう。

 > Set wb = Workbooks.Open(fol & "\" & f)
 >     wb.Sheets("計画書").PrinOut
 >     wb.Close

 ↓のようにしてみてください。

  Set wb = Workbooks.Open(fol & "\" & f)
      wb.Sheets("計画書").PrintOut
      wb.Close SaveChanges:=False

  「SaveChanges:=False」を付加することで、編集を破棄します。

 さらに、ブックの開閉を見せないようにするには、

   Application.ScreenUpdating = False '画面の再描画停止
    Set wb = Workbooks.Open(fol & "\" & f)
    wb.Sheets("計画書").PrintOut
    wb.Close SaveChanges:=False
    Application.ScreenUpdating = True '画面の再描画再開

 とします。
 (MARBIN)

MARBINさん
本当にありがとうございました。ご指摘の通りご指摘の通り=today()の式がありました。作成してくださったコードでサクサク印刷できました。これで仕事がはかどりますっ。本当にありがとうございました!!(石田)

 とりまとめをば・・・。

 Sub test()
  Const fol As String = "\\Fssvr\書棚\c1-3分院リハビリ科\リハ計画・サマリー・患者管理\リハ計画書(リハ)"
  Dim f As String
  Dim wb As Workbook
   f = Dir(fol & "\*.xls") 'ファイル名の取り出し
   Do While f <> "" 'ファイルがなくなるまで
   Application.ScreenUpdating = False '画面の再描画停止
    Set wb = Workbooks.Open(fol & "\" & f) 'ブックを開き変数wbにセット
    wb.Sheets("計画書").PrintOut 'シートをプリントアウト
    wb.Close SaveChanges:=False '編集を破棄してブックを閉じる
    Application.ScreenUpdating = True '画面の再描画再開
    f = Dir()
   Loop
   Set wb = Nothing '変数wbの開放
 End Sub
 (MARBIN)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.