Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


5993 / 13644 ツリー ←次へ | 前へ→

【47748】複数ファイルの特定シートを一括で印刷したい 本山 祐二 07/3/21(水) 16:03 質問[未読]
【47749】Re:複数ファイルの特定シートを一括で印刷... Kein 07/3/21(水) 16:06 発言[未読]
【47750】Re:複数ファイルの特定シートを一括で印刷... 本山 祐二 07/3/21(水) 16:12 発言[未読]
【47753】Re:複数ファイルの特定シートを一括で印刷... Kein 07/3/21(水) 20:18 発言[未読]
【47755】Re:複数ファイルの特定シートを一括で印刷... 本山 祐二 07/3/21(水) 20:52 発言[未読]
【47756】Re:複数ファイルの特定シートを一括で印刷... Kein 07/3/21(水) 21:22 発言[未読]
【47757】Re:複数ファイルの特定シートを一括で印刷... 本山 祐二 07/3/21(水) 21:39 発言[未読]
【47759】Re:複数ファイルの特定シートを一括で印刷... Kein 07/3/21(水) 22:23 回答[未読]
【47760】Re:複数ファイルの特定シートを一括で印刷... 本山 祐二 07/3/21(水) 23:09 お礼[未読]
【47761】Re:複数ファイルの特定シートを一括で印刷... Kein 07/3/21(水) 23:43 発言[未読]
【47762】Re:複数ファイルの特定シートを一括で印刷... 本山 祐二 07/3/22(木) 1:17 発言[未読]
【47763】Re:複数ファイルの特定シートを一括で印刷... りん 07/3/22(木) 3:27 発言[未読]
【47768】Re:複数ファイルの特定シートを一括で印刷... 本山 祐二 07/3/22(木) 10:05 発言[未読]
【47770】Re:複数ファイルの特定シートを一括で印刷... りん 07/3/22(木) 11:45 発言[未読]
【47778】Re:複数ファイルの特定シートを一括で印刷... 本山 祐二 07/3/22(木) 13:28 お礼[未読]
【47782】Re:複数ファイルの特定シートを一括で印刷... Kein 07/3/22(木) 13:51 回答[未読]
【47810】Re:複数ファイルの特定シートを一括で印刷... 本山 祐二 07/3/22(木) 20:25 お礼[未読]

【47748】複数ファイルの特定シートを一括で印刷し...
質問  本山 祐二  - 07/3/21(水) 16:03 -

引用なし
パスワード
   お世話になっております。

初級者ですがよろしくお願いいたします。

同じようなファイル200ファイルあります。
そのファイルのある特定のシート(”別紙”と”表紙”)のみ、
印刷したいのですが可能でしょうか?

例:A列にファイルの一覧があります。

  A
1 マルバツ.xls
2 さんかく.xls
3 まるまる.xls 
4 ▽印.xls
5 まるさん.xls
  ・
  ・
  ・
  ・

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

【47749】Re:複数ファイルの特定シートを一括で印...
発言  Kein  - 07/3/21(水) 16:06 -

引用なし
パスワード
   >特定のシート(”別紙”と”表紙”)
の、それぞれの印刷範囲はどこですか ?

【47750】Re:複数ファイルの特定シートを一括で印...
発言  本山 祐二  - 07/3/21(水) 16:12 -

引用なし
パスワード
   ▼Kein さん:
>>特定のシート(”別紙”と”表紙”)
>の、それぞれの印刷範囲はどこですか ?

説明不足ですません。

シート名です。

【47753】Re:複数ファイルの特定シートを一括で印...
発言  Kein  - 07/3/21(水) 20:18 -

引用なし
パスワード
   印刷範囲というのは、セル範囲のことです。A1:E20 とかの。
シート名を印刷しても仕方がないでしょ・・?

【47755】Re:複数ファイルの特定シートを一括で印...
発言  本山 祐二  - 07/3/21(水) 20:52 -

引用なし
パスワード
   ▼Kein さん:
>印刷範囲というのは、セル範囲のことです。A1:E20 とかの。
>シート名を印刷しても仕方がないでしょ・・?


シート(”別紙”と”表紙”)
には、既に印刷範囲の設定してありますので、
シートを選んで印刷ボタンを押すみたいなイメージなのですが。。。

説明が下手ですいません。

【47756】Re:複数ファイルの特定シートを一括で印...
発言  Kein  - 07/3/21(水) 21:22 -

引用なし
パスワード
   >既に印刷範囲の設定してあります
それはいいのですが、200個もファイルがあったら、いちいち一つずつ開いて
印刷していたのでは時間がかかり過ぎる、と推測してます。なのでマクロ実行
ブックの作業用(印刷用)シート2枚に、リンクで印刷範囲の値を転記し、それを
繰り返し印刷するようなコードを考えているのです。
印刷範囲を知りたいと言ったのは、そのリンクする範囲を設定するためなのです。

【47757】Re:複数ファイルの特定シートを一括で印...
発言  本山 祐二  - 07/3/21(水) 21:39 -

引用なし
パスワード
   ▼Kein さん:
>>既に印刷範囲の設定してあります
>それはいいのですが、200個もファイルがあったら、いちいち一つずつ開いて
>印刷していたのでは時間がかかり過ぎる、と推測してます。なのでマクロ実行
>ブックの作業用(印刷用)シート2枚に、リンクで印刷範囲の値を転記し、それを
>繰り返し印刷するようなコードを考えているのです。
>印刷範囲を知りたいと言ったのは、そのリンクする範囲を設定するためなのです。

失礼しました。
別紙シートの印刷範囲は、A4:B9
表紙シートの印刷範囲は、A1:I10

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

【47759】Re:複数ファイルの特定シートを一括で印...
回答  Kein  - 07/3/21(水) 22:23 -

引用なし
パスワード
   了解しました。それでは仮に・・
>A列にファイルの一覧
があるシートを "Sheet1", 表紙シートの値を転記してくるシートを
"Sheet2", 別紙シートの転記先を "Sheet3" として、ファイル一覧の
ブックは全て、マクロを実行するブックと同じフォルダーに保存されている、
とします。
これでも処理時間は長くなりそうなので、マクロを緊急停止できるように
キートラップコードを入れておきます。中止したいときに "Esc"キー を連打
してみて下さい。
コードは以下のようになります。シート名を適宜変更してから実行してください。

Sub MyData_Print()
  Dim MyR As Range, C As Range
  Dim MyF As String, LkS As String
 
  With Sheets("Sheet1")
   Set MyR = .Range("A1", .Range("A65536").End(xlUp))
  End With
  On Error GoTo ELine
  Application.EnableCancelKey = xlErrorHandler
  For Each C In MyR
   MyF = ThisWorkbook.Path & "\" & C.Value
   If Dir(MyF) <> "" Then
     LkS = "='" & ThisWorkbook.Path & "\[" & C.Value & "]"
     With Sheets("Sheet2").Range("A1:I10")
      .Formula = LkS & "表紙!'A1"
      .PrintOut Copies:=1
      .ClearContents
     End With
     With Sheets("Sheet3").Range("A1:B6")
      .Formula = LkS & "別紙!'A4"
      .PrintOut Copies:=1
      .ClearContents
     End With
   Else
     Debug.Print C.Value & " = 存在しない"
   End If
  Next
ELine:
  Set MyR = Nothing
  If Err.Number = 0 Then
   MsgBox "全ての印刷を終了しました" & vbLf & _
   "存在しないブックはイミディエイトウィンドウで確認できます"
  ElseIf Err.Number = 18 Then
   MsgBox "ユーザーの操作によってマクロを中止します"
  Else
   MsgBox "予期しないエラー発生 ! マクロを中止します" & _
   vbLf & Err.Number & vbLf & Err.Description
  End If
End Sub

【47760】Re:複数ファイルの特定シートを一括で印...
お礼  本山 祐二  - 07/3/21(水) 23:09 -

引用なし
パスワード
   ▼Kein さん:
ありがとうございます。

早速試してみました。
・新しいブックを作成("Sheet1""Sheet2""Sheet3")
・そのブックにマクロを記述(標準モジュールに)
・"Sheet1"のA列にファイル名を
・マクロを実行するブックと同じフォルダーに入れました。

試しに10ファイルやってみたのですが、実行後、すぐに下記のエラーが出ます。
”アプリケーション定義またはオブジェクト定義エラーが出ます。1004”

お手数おかけしますが、
よろしくお願いいたします。


▼Kein さん:
>了解しました。それでは仮に・・
>>A列にファイルの一覧
>があるシートを "Sheet1", 表紙シートの値を転記してくるシートを
>"Sheet2", 別紙シートの転記先を "Sheet3" として、ファイル一覧の
>ブックは全て、マクロを実行するブックと同じフォルダーに保存されている、
>とします。
>これでも処理時間は長くなりそうなので、マクロを緊急停止できるように
>キートラップコードを入れておきます。中止したいときに "Esc"キー を連打
>してみて下さい。
>コードは以下のようになります。シート名を適宜変更してから実行してください。
>
>Sub MyData_Print()
>  Dim MyR As Range, C As Range
>  Dim MyF As String, LkS As String
> 
>  With Sheets("Sheet1")
>   Set MyR = .Range("A1", .Range("A65536").End(xlUp))
>  End With
>  On Error GoTo ELine
>  Application.EnableCancelKey = xlErrorHandler
>  For Each C In MyR
>   MyF = ThisWorkbook.Path & "\" & C.Value
>   If Dir(MyF) <> "" Then
>     LkS = "='" & ThisWorkbook.Path & "\[" & C.Value & "]"
>     With Sheets("Sheet2").Range("A1:I10")
>      .Formula = LkS & "表紙!'A1"
>      .PrintOut Copies:=1
>      .ClearContents
>     End With
>     With Sheets("Sheet3").Range("A1:B6")
>      .Formula = LkS & "別紙!'A4"
>      .PrintOut Copies:=1
>      .ClearContents
>     End With
>   Else
>     Debug.Print C.Value & " = 存在しない"
>   End If
>  Next
>ELine:
>  Set MyR = Nothing
>  If Err.Number = 0 Then
>   MsgBox "全ての印刷を終了しました" & vbLf & _
>   "存在しないブックはイミディエイトウィンドウで確認できます"
>  ElseIf Err.Number = 18 Then
>   MsgBox "ユーザーの操作によってマクロを中止します"
>  Else
>   MsgBox "予期しないエラー発生 ! マクロを中止します" & _
>   vbLf & Err.Number & vbLf & Err.Description
>  End If
>End Sub

【47761】Re:複数ファイルの特定シートを一括で印...
発言  Kein  - 07/3/21(水) 23:43 -

引用なし
パスワード
   >On Error GoTo ELine
の頭にシングルクォーテーション "'" を付けてコメント化し、
もう一度テストしてみて下さい。デバッグ画面で色が変わっている
行を確認し、そのコードを報告して下さい。

【47762】Re:複数ファイルの特定シートを一括で印...
発言  本山 祐二  - 07/3/22(木) 1:17 -

引用なし
パスワード
   ▼Kein さん:
>>On Error GoTo ELine
>の頭にシングルクォーテーション "'" を付けてコメント化し、
>もう一度テストしてみて下さい。デバッグ画面で色が変わっている
>行を確認し、そのコードを報告して下さい。


お世話になっております。

このコードがだめみたいです。

.Formula = LkS & "表紙!'A1"


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

【47763】Re:複数ファイルの特定シートを一括で印...
発言  りん E-MAIL  - 07/3/22(木) 3:27 -

引用なし
パスワード
   本山 祐二 さん、こんばんわ。

数式(Formula)の ’と !の位置が逆のようです。

.Formula = LkS & "表紙!'A1"
 ↓
.Formula = LkS & "表紙'!A1"


.Formula = LkS & "別紙'!A4"
 ↓
.Formula = LkS & "別紙!'A4"

【47768】Re:複数ファイルの特定シートを一括で印...
発言  本山 祐二  - 07/3/22(木) 10:05 -

引用なし
パスワード
   りんさん
ありがとうございます。

逆とのことですが、
メールの回答が逆になってない!?
(いっしょ)
よろしくお願いいたします。

▼りん さん:
>本山 祐二 さん、こんばんわ。
>
>数式(Formula)の ’と !の位置が逆のようです。
>
>.Formula = LkS & "表紙!'A1"
> ↓
>.Formula = LkS & "表紙'!A1"
>
>
>.Formula = LkS & "別紙'!A4"
> ↓
>.Formula = LkS & "別紙!'A4"

【47770】Re:複数ファイルの特定シートを一括で印...
発言  りん E-MAIL  - 07/3/22(木) 11:45 -

引用なし
パスワード
   本山 祐二 さん、こんにちわ。
逆とのことですが、
>メールの回答が逆になってない!?
>(いっしょ)
メール?一緒?
Keinさんの、このコードで数式を指定する部分

  For Each C In MyR
   MyF = ThisWorkbook.Path & "\" & C.Value
   If Dir(MyF) <> "" Then
     LkS = "='" & ThisWorkbook.Path & "\[" & C.Value & "]"
     With Sheets("Sheet2").Range("A1:I10")
      .Formula = LkS & "表紙!'A1"
      .PrintOut Copies:=1
      .ClearContents
     End With
     With Sheets("Sheet3").Range("A1:B6")
      .Formula = LkS & "別紙!'A4"
      .PrintOut Copies:=1
      .ClearContents
     End With
   Else
     Debug.Print C.Value & " = 存在しない"
   End If
  Next


見やすいように空白を入れてあります

 旧: .Formula = LkS & "表紙 ! ' <>A1"
        ↓
 新: .Formula = LkS & "表紙 ' ! A1"


夜中のは下の式が逆になってましたね。すみません。

【47778】Re:複数ファイルの特定シートを一括で印...
お礼  本山 祐二  - 07/3/22(木) 13:28 -

引用なし
パスワード
   keinさん
りんさん

ありがとうございました。
ものすごいスピードで印刷され
うまく動きました。

ただ、印刷したものは、数字などしか印刷されませんでした。
(設定されていたレイアウトや罫線、写真が無視されている。。。)

・表紙シートには、罫線や写真があります。
・別紙シートには、数字と罫線があります。

お手数おかけしますが、
よろしくお願いいたします。

▼りん さん:
>本山 祐二 さん、こんにちわ。
>逆とのことですが、
>>メールの回答が逆になってない!?
>>(いっしょ)
>メール?一緒?
>Keinさんの、このコードで数式を指定する部分
>
>  For Each C In MyR
>   MyF = ThisWorkbook.Path & "\" & C.Value
>   If Dir(MyF) <> "" Then
>     LkS = "='" & ThisWorkbook.Path & "\[" & C.Value & "]"
>     With Sheets("Sheet2").Range("A1:I10")
>      .Formula = LkS & "表紙!'A1"
>      .PrintOut Copies:=1
>      .ClearContents
>     End With
>     With Sheets("Sheet3").Range("A1:B6")
>      .Formula = LkS & "別紙!'A4"
>      .PrintOut Copies:=1
>      .ClearContents
>     End With
>   Else
>     Debug.Print C.Value & " = 存在しない"
>   End If
>  Next
>
>
>見やすいように空白を入れてあります
>
> 旧: .Formula = LkS & "表紙 ! ' <>A1"
>        ↓
> 新: .Formula = LkS & "表紙 ' ! A1"
>
>
>夜中のは下の式が逆になってましたね。すみません。

【47782】Re:複数ファイルの特定シートを一括で印...
回答  Kein  - 07/3/22(木) 13:51 -

引用なし
パスワード
   あー・・どーも。本山 祐二さんすいませんでした。
りんさんフォロー有難うございます。
>・表紙シートには、罫線や写真があります。
>・別紙シートには、数字と罫線があります。
ということですと、やはりブックを一つずつ開いて印刷する、
というやり方しかありませんね。
先のマクロを、以下のように変更して下さい。

Sub MyData_Print2()
  Dim MyR As Range, C As Range
  Dim MyF As String
 
  With Sheets("Sheet1")
   Set MyR = .Range("A1", .Range("A65536").End(xlUp))
  End With
  On Error GoTo ELine
  With Application
   .EnableCancelKey = xlErrorHandler
   .ScreenUpdating = False
  End With
  For Each C In MyR
   MyF = ThisWorkbook.Path & "\" & C.Value
   If Dir(MyF) <> "" Then
    Workbooks.Open MyF
    With ActiveWorkbook
      .Sheets("表紙").PrintOut Copies:=1
       .Sheets("別紙").PrintOut Copies:=1
       .Close False
     End With
   Else
     Debug.Print C.Value & " = 存在しない"
   End If
  Next
ELine:
  Application.ScreenUpdating = True
  Set MyR = Nothing
  If Err.Number = 0 Then
   MsgBox "全ての印刷を終了しました" & vbLf & _
   "存在しないブックはイミディエイトウィンドウで確認できます"
  ElseIf Err.Number = 18 Then
   MsgBox "ユーザーの操作によってマクロを中止します"
  Else
   MsgBox "予期しないエラー発生 ! マクロを中止します" & _
   vbLf & Err.Number & vbLf & Err.Description
  End If
End Sub

【47810】Re:複数ファイルの特定シートを一括で印...
お礼  本山 祐二  - 07/3/22(木) 20:25 -

引用なし
パスワード
   kein様
りん様

お忙しい中
ありがとうございました。

うまく印刷できました。
(VBAすばらしい)

今後ともよろしくお願いいたします。

▼Kein さん:
>あー・・どーも。本山 祐二さんすいませんでした。
>りんさんフォロー有難うございます。
>>・表紙シートには、罫線や写真があります。
>>・別紙シートには、数字と罫線があります。
>ということですと、やはりブックを一つずつ開いて印刷する、
>というやり方しかありませんね。
>先のマクロを、以下のように変更して下さい。
>
>Sub MyData_Print2()
>  Dim MyR As Range, C As Range
>  Dim MyF As String
> 
>  With Sheets("Sheet1")
>   Set MyR = .Range("A1", .Range("A65536").End(xlUp))
>  End With
>  On Error GoTo ELine
>  With Application
>   .EnableCancelKey = xlErrorHandler
>   .ScreenUpdating = False
>  End With
>  For Each C In MyR
>   MyF = ThisWorkbook.Path & "\" & C.Value
>   If Dir(MyF) <> "" Then
>    Workbooks.Open MyF
>    With ActiveWorkbook
>      .Sheets("表紙").PrintOut Copies:=1
>       .Sheets("別紙").PrintOut Copies:=1
>       .Close False
>     End With
>   Else
>     Debug.Print C.Value & " = 存在しない"
>   End If
>  Next
>ELine:
>  Application.ScreenUpdating = True
>  Set MyR = Nothing
>  If Err.Number = 0 Then
>   MsgBox "全ての印刷を終了しました" & vbLf & _
>   "存在しないブックはイミディエイトウィンドウで確認できます"
>  ElseIf Err.Number = 18 Then
>   MsgBox "ユーザーの操作によってマクロを中止します"
>  Else
>   MsgBox "予期しないエラー発生 ! マクロを中止します" & _
>   vbLf & Err.Number & vbLf & Err.Description
>  End If
>End Sub

5993 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free