[[20140205110247]]　『異なるブックの複数のシートを一括でプリントした』（林檎姫太郎）　ページの最後に飛ぶ

『異なるブックの複数のシートを一括でプリントしたい』（林檎姫太郎）

異なるブックの複数のシートを一括でプリントしたい

お世話になります。いつも勉強させていただいています。

以前こちらの質問コーナーでハイパーリンクについて学び

異なるブックの複数シートから欲しいシートだけ印刷を行っていましたが、

毎回ブックを開いて印刷する事がおっくうになってきて、もっと楽にしたいと思うようになりました。

今まで、集約というブックにて下記状態に設定しリンク先を修正して印刷を行っていました。

・Ａ列にファイルアドレス(300位)

・Ｂ列にシート名(1200位)

・Ｃ列にハイパーリンク（飛んだ先のＢ１選択）

全ブック全シートは同じフォーマットですので、ハイパーリンクにて飛んだあと

Ｂ１とＣ４のセル内容を修正して印刷をしています。

新しくしたいことは、1～3のボタンを作って

1　集約ブックのＤ列に飛んだ先のＢ１とＥ列に飛んだ先のＣ４を表示させる

2　集約ブックのＤ列Ｅ列に今回印刷したい文字を入れると、シートに集約ブックの文字を置き換える

3　Ｆ列に１と入力したら飛んだ先のシートをブックを開く事無く印刷する

といった事がしたいです。

マクロは記録して操作くらいしかしたことないのですが、

こんな事出るかを考えており、アドバイス頂けますとうれしいです。

＜使用 Excel：Excel2003、使用 OS：Windows7 ＞

 なかなか回答付きませんねぇ。
 質問です。
 １）ABC列は具体的にどのように入力されていますか？
 ２）2は既にシートが開かれていた場合、どうしますか？
 ３）3はそれらしく見せることは出来ますが、たぶん開かないと印刷は出来ないと思います。
 　　それでもよろしいですか？

（稲葉） 2014/02/06(木) 15:51

お返事ありがとうございます
1)A列はファイルのフルアドレスに\とファイル名が入ってます
B列はシート名が入ってます
C列はハイパーリンクの関数をいれてジャンプできるようにしています

2)はないはずですがたとえ開かれてても有無を言わさず文字を入れ込みたいです
3)は楽になればいいだけなので開いてもいいです

説明が悪くてすいません

正直、何処かの行程が楽になったらいいなと思い投稿してみたのですがまとまりが悪かったみたいですね

ちょこっとのアドバイスをいただけますと嬉しいです

よろしくお願いします

(林檎姫太郎)

 まずここの使い方から覚えてくださいね。
 返信は下のコメント欄からお願いします。

 １）同じことを言葉を変えて説明するのではなく、実例を挙げていただかないと
 　　お互い勘違いのまま進んでしまうことが多々あります。
 　　差しさわりのない程度でお願いします。

 ２）は開かれていたら保存できないので不可能です。
 ３）了解しました。

 ＞正直、何処かの行程が楽になったらいいなと思い投稿してみたのですがまとまりが悪かったみたいですね 
 読みにくいだけです。
 ハイパーリンクのくだりから、印刷したいまでが長すぎます。
 要件を先に言わないと伝わりにくいものです。

（稲葉） 2014/02/07(金) 08:36

 こんな感じでいかがでしょう？
'==定数定義==============================================================================================
Const A_Data As String = "B1"
Const B_Data As String = "C4"
'========================================================================================================
Sub データ取得()
    Dim ErrMsg As String
    Dim tmpPATH As String
    Dim i As Long
    Dim objFSO As Object
    i = 1
    ErrMsg = "取り込み失敗" & vbNewLine
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Do
        If Cells(i, "A") = "" Then Exit Do
        On Error Resume Next
        tmpPATH = objFSO.getFilename(Cells(i, "A").Value)
        tmpPATH = "'" & Application.Substitute(Cells(i, "A").Value, tmpPATH, "[" & tmpPATH & "]")
        tmpPATH = tmpPATH & Cells(i, "B").Value & "'!"
        Cells(i, "D").Value = ExecuteExcel4Macro(tmpPATH & Application.ConvertFormula(A_Data, xlA1, xlR1C1, 1))
        Cells(i, "E").Value = ExecuteExcel4Macro(tmpPATH & Application.ConvertFormula(B_Data, xlA1, xlR1C1, 1))
        On Error GoTo 0
        If Err > 0 Then ErrMsg = ErrMsg & i & "行目" & tmpPATH & vbNewLine: Err.Clear
        i = i + 1
    Loop
    If Len(ErrMsg) > 6 Then MsgBox ErrMsg
    Set objFSO = Nothing
End Sub
'========================================================================================================
Sub データインプット()
    Dim ErrMsg As String
    Dim tmpPATH As String
    Dim tmpSHHT As String
    Dim tmpADAT As String
    Dim tmpBDAT As String
    Dim i As Long
    ErrMsg = "入力失敗" & vbNewLine
    i = 1
    Do
        If Cells(i, "A") = "" Then Exit Do
        On Error Resume Next
        tmpPATH = Cells(i, "A").Value
        tmpSHHT = Cells(i, "B").Value
        tmpADAT = Cells(i, "D").Value
        tmpBDAT = Cells(i, "E").Value
        Open tmpPATH For Append As #1: Close #1
        On Error GoTo 0
        If Err > 0 Then
            ErrMsg = ErrMsg & tmpPATH & vbNewLine
            Err.Clear
        Else
            Application.DisplayAlerts = False
            With Workbooks.Open(tmpPATH)
                With .Sheets(tmpSHHT)
                    .Range(A_Data) = tmpADAT
                    .Range(B_Data) = tmpBDAT
                End With
                .Save
                .Close
            End With
            ThisWorkbook.Activate
            Application.DisplayAlerts = True
        End If
        i = i + 1
    Loop
    If Len(ErrMsg) > 4 Then MsgBox ErrMsg
End Sub
'========================================================================================================
Sub 印刷()
    Dim tmpPATH As String
    Dim tmpSHHT As String
    Dim i As Long
    i = 1
    Do
        If Cells(i, "A").Value = "" Then Exit Do
        If Cells(i, "F").Value = 1 Then
        tmpPATH = Cells(i, "A").Value
        tmpSHHT = Cells(i, "B").Value
        Application.DisplayAlerts = False
        With Workbooks.Open(tmpPATH, ReadOnly:=True)
            .Sheets(tmpSHHT).PrintOut
            .Close
        End With
        ThisWorkbook.Activate
        Application.DisplayAlerts = True
        End If
        i = i + 1
    Loop
End Sub

（稲葉） 2014/02/07(金) 10:19

Fw:
稲葉様、ご指導ご教授有難うございます。

使い方、承知しました。

「データ取得」で取り込みをさせてもらった所、値の更新１の要求がきて
キャンセルすると失敗しましたのメッセージが出ました。

説明を具体的に書きますので誠に恐縮ですが、
もう一度、ご教授頂けないでしょうか。

「集約．xls」の「シート１」に下記状態で入っています。
　　　Ａ　　　　Ｂ　　　Ｃ　　　Ｄ　　　Ｅ　　　Ｆ
　１　パス　　　シート　リンク　Ｂ１セル　Ｃ４セル　印刷部数
　２　\\C:\TES1.xls\　1　　　リンク 2　　　 H　　　 1
　３　\\C:\TES2.xls\　3　　　リンク 2　　　 A　　　 1
　４　\\C:\TES5.xls\　5　　　リンク 2　　　 BB　　 1
　５　\\C:\TES5.xls\　7　　　リンク 2　　　 kk

印刷したい対象のファイルは全て同じフォーマットで下記状態です。
Ｂ１-Ｃ３　セル結合　・・・　１～３文字全半角文字
Ｃ４-Ｄ７　セル結合　・・・　１～３文字全半角文字

せっかく、コードを作っていただいたのに申し訳ありません。
よろしくお願い致します。

（林檎姫太郎）
（林檎姫太郎） 2014/02/12(水) 14:40

 ＞「データ取得」で取り込みをさせてもらった所、値の更新１の要求がきて 
 ＞キャンセルすると失敗しましたのメッセージが出ました。 
 再現できないけど、ちょっと間違えた部分がありました。
    If Len(ErrMsg) > 6 Then MsgBox ErrMsg
 ここを
    If Len(ErrMsg) > 8 Then MsgBox ErrMsg
 こちらに。

 ＞\\C:\TES1.xls\
 パスがこれだとおかしいでしょう？

 F列が印刷部数っていうことは、1なら1枚、2なら2枚？

 ほか結合の有無関係なくこちらでは動いています。

（稲葉） 2014/02/13(木) 08:49

お世話になります

一行目にタイトルを書いていたにを消すとうまく行きました

稲葉さまの仰る通り具体例が必要であることを痛感しました

取得ができましたので引き続き、確認していきます

取り急ぎお礼まで

又ご報告します
（林檎姫太郎） 2014/02/13(木) 13:00

コメント返信：

[ 一覧(最新更新順) ]

[[20140205110247]] 『異なるブックの複数のシートを一括でプリントした』（林檎姫太郎） ページの最後に飛ぶ

[[20140205110247]]　『異なるブックの複数のシートを一括でプリントした』（林檎姫太郎）　ページの最後に飛ぶ