|
▼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
|
|