[[20200512163759]]　『説明書とリンクさせて自動印刷』（オラクル）　ページの最後に飛ぶ

『説明書とリンクさせて自動印刷』（オラクル）

前回はファイルアップロードできていないことに気づかず、また突然の出張等でインターネット環境にない状態で放置となってしまい申し訳ありませんでした。
再度、ご教授いただきたく再登校させていただいております。
何卒ご助言お願いい致します。

したいこと
?@ アップロード「https://1drv.ms/x/s!AtV0XL_8OJ6JgQHX5Tf7jO_Hz90P?e=UMflbT」したエクセルファイルの内容が出力されます（セルの位置等は同じで作成しました）。
?A この出力された?@のシートを全選択コピーして別エクセルに貼付してマクロで動かしたい。
↓
?B 現在ある説明書と?@のエクセルファイルとをリンクさせ、該当する説明書（）をボタン一つで自動印刷したい
?C 可能なら説明書のテンプレートは左上A１セルは空白ですが、エクセルファイル?@のセルCを拾って印刷時に患者氏名を印字したい。

現状
・説明書はワードファイル、もしくはエクセルファイルで画像、文字で記載されています。
・説明書は「説明書フォルダ」に?@エクセルの　I列「レジメン名」のファイル名で保存されています。
・レジメン数は約300程あります
・患者氏名は重複する可能性あり患者IDで識別が必要

＜使用 Excel：Excel2011(Mac)、使用 OS：Windows10 ＞

文字化けを修正しなさい。
（） 2020/05/12(火) 16:59

[[20200424163430]]　『説明書の自動印刷マクロを作りたい』（オラクル）
↑の再投稿ですよね。トピック分けずに続きにしたらどうですか？

また、よくわからないところにアップロードされたとしてみない人もいるとおもいますから、極力文字で説明されたほうが、回答は付きやすいとおもいます。

さらに、多少なりとも自分で考えたところがあるなら、それも提示したほうがよいです。
（動かなくても、コードからやろうとしてることが推測できる場合があるため）

（もこな２） 2020/05/12(火) 17:10

 こんばんは　＾＾
ちょこっと、つくってみました。もっとスマートな方法はたくさん
有るとはおもいますが。こんな感じでも。。。出来なくはないかも
、憶測と推測の部分もたくさんありますので、ご希望に添えない場
合は、ゴミ箱にでも。A^_^;　要バックアップ、必須です。
ご考察の一助にでもなれば幸甚です｡
m(_ _)m
'**********************************************************
'* このマクロブックの保存名はzBase001.xlsmです。［変更可能］
'* このブックのサブフォルダ、説明書、の中に説明ブックが必要
'* 数、有ると仮定しています。、説明ブックの一番左端のシート
'* が出力対象シートです。実際に出力する場合はPrintOutに変更
'* が必要です。印刷設定等は済んでいるものといたします。
'* 予定出力.xlsxはこのブックと同じ、とある、フォルダに有ると
'* いたします。
'**********************************************************
Option Explicit
Sub OneInstanceMain()
    Const zProgramID  As String = "zBase001.xlsm"
    Const zBbookNm    As String = "予定出力.xlsx"
    Dim zRbNm         As String
    Dim zTb           As Workbook
    Dim zBaseb        As Workbook
    Dim zRb           As Workbook
    Dim i             As Long
    Dim zBase()       As Variant
    Dim zDic          As Object
    Dim zVar          As Variant
    Set zDic = CreateObject("Scripting.Dictionary")
    Set zTb = Workbooks(zProgramID)
    Set zBaseb = Workbooks.Open(zTb.Path & "\" & zBbookNm)
    With zBaseb.Worksheets(1)
        zBase = .Cells(1).CurrentRegion.Value
    End With
    zBaseb.Close False
    Set zBaseb = Nothing
    For i = 2 To UBound(zBase, 1)
        zDic(zBase(i, 2)) = zBase(i, 2) & Chr(30) & zBase(i, 3) & Chr(30) & zBase(i, 4) & Chr(30) & zBase(i, 9)
    Next
    For Each zVar In zDic
        zRbNm = Split(zDic(zVar), Chr(30))(3)
        Set zRb = Workbooks.Open(zTb.Path & "/説明書/" & zRbNm & ".xlsx")
        With zRb.Worksheets(1)
            .Cells(1) = Split(zDic(zVar), Chr(30))(1) & " 様"
            .PrintPreview
        End With
        zRb.Close False
        Set zRb = Nothing
    Next
    Erase zBase
    Set zTb = Nothing
    Set zDic = Nothing
End Sub
（隠居じーさん） 2020/05/12(火) 19:42

隠居じーさん様
ご丁寧にありがとうございます。
試しにしてみました。
多少修正が必要そうですが、ほぼ理想通りです。
ここからは頑張ってみようと思いますので、
また何かございましたらよろしくお願いいたします。

本当に多々ご迷惑をおかけして申し訳ありませんでした。
（オラクル） 2020/05/13(水) 23:54

 m(_ _)m
（隠居じーさん） 2020/05/14(木) 08:23

コメント返信：

[ 一覧(最新更新順) ]

[[20200512163759]] 『説明書とリンクさせて自動印刷』（オラクル） ページの最後に飛ぶ

[[20200512163759]]　『説明書とリンクさせて自動印刷』（オラクル）　ページの最後に飛ぶ