Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5995 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【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
１　マルバツ.xls
２　さんかく.xls
３　まるまる.xls　
４　▽印.xls
５　まるさん.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個もファイルがあったら、いちいち一つずつ開いて
印刷していたのでは時間がかかり過ぎる、と推測してます。なのでマクロ実行
ブックの作業用(印刷用)シート２枚に、リンクで印刷範囲の値を転記し、それを
繰り返し印刷するようなコードを考えているのです。
印刷範囲を知りたいと言ったのは、そのリンクする範囲を設定するためなのです。


	【47757】Re:複数ファイルの特定シートを一括で印...

本山　祐二 - 07/3/21(水) 21:39 -


	引用なし

	パスワード

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

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

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


	【47759】Re:複数ファイルの特定シートを一括で印...

Kein - 07/3/21(水) 22:23 -


	引用なし

	パスワード

了解しました。それでは仮に・・
>Ａ列にファイルの一覧
があるシートを "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列にファイル名を
・マクロを実行するブックと同じフォルダーに入れました。

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

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

▼Kein さん：
>了解しました。それでは仮に・・
>>Ａ列にファイルの一覧
>があるシートを "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:複数ファイルの特定シートを一括で印...

りん

- 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:複数ファイルの特定シートを一括で印...

りん

- 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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5995 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free