[[20150713163729]]　『マクロで指定したセルの文字列の一部を参照し、別』（ケイコ）　ページの最後に飛ぶ

『マクロで指定したセルの文字列の一部を参照し、別フォルダのワード文書を検索し印刷したい』（ケイコ）

よろしくお願いします。

 ブックにお得意様名と通し番号がずらっとならんでいます
 例）１セルに　海馬遊戯234　みたいな感じです
 （下３桁が通し番号になっています）
 目的のお得意先セルをクリックし、マクロボタンを押したら
 別フォルダ（仮にAAA）内に多数入っているワードの文書名から
 通し番号を検索して、印刷できるようにしたいのです。
 ワード文書のお得意先の名前は必ずしも一致せず、
 番号だけが一致します（例では234）
 この可能でしょうか？

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

 これを、わざわざエクセルで？

 ワードを読みこむのに、どっこいしょという感じで、ちょっと重いですが。

 マクロブックの Sheet1 の A列１行目から下に、ｘｘｘ234 といったものが指定されているという前提。
 またフォルダはデスクトップ上の "Test" という名前にしてあります。

 Sub Test()
    Dim fPath As String
    Dim fName As String
    Dim wd As Object
    Dim doc As Object
    Dim c As Range
    Dim num As String

    Set wd = CreateObject("Word.Application")

    fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Test\"

    With Sheets("Sheet1")   'シート名

        For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
            num = StrReverse(Val(StrReverse(c.Value)))

            fName = Dir(fPath & "*" & num & ".docx")

            Do While fName <> ""
                Set doc = wd.documents.Open(fPath & fName)
                doc.PrintOut
                doc.Close
                fName = Dir()
            Loop

        Next

    End With

 End Sub

（β） 2015/07/13(月) 19:21

βさま　ありがとうございます。

 私の説明が不足していたかもしれません。
 得意先名は1セル1名ずつで、ずらっと100名以上ならんでおり
 クリックしたセル（アクティブの）の得意先名を
 検索したいのです。
 教えて頂いた内容で試してみましたが
 上手く動きませんでした。
 Activecell.Value…みたいな感じで書き換えるのでしょうか？
 考えてみましたが…どのようにしたらよいでしょうか。
 お手数をおかけします。
（ケイコ） 2015/07/13(月) 20:56

 あぁ、クリックを見過ごしていました。

 それでは

 Sub Test2()
    Dim fPath As String
    Dim fName As String
    Dim wd As Object
    Dim doc As Object
    Dim num As String

    If IsEmpty(Selection(1)) Then Exit Sub
    If Selection(1).Column <> 1 Then Exit Sub

    Set wd = CreateObject("Word.Application")

    fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Test\"

    num = StrReverse(Val(StrReverse(Selection(1).Value)))

    fName = Dir(fPath & "*" & num & ".docx")

    Do While fName <> ""
        Set doc = wd.documents.Open(fPath & fName)
        doc.PrintOut
        doc.Close
        fName = Dir()
    Loop

 End Sub

 でも、おすすめは、シートモジュール（シートタブを右クリック->コードの表示）に。
 A列の任意のセルをダブルクリックで処理します。

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim fPath As String
    Dim fName As String
    Dim wd As Object
    Dim doc As Object
    Dim num As String

    If Intersect(Target, Columns("A")) Is Nothing Then Exit Sub
    If IsEmpty(Target) Then Exit Sub

    Cancel = True

    Set wd = CreateObject("Word.Application")

    fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Test\"

    num = StrReverse(Val(StrReverse(Selection(1).Value)))

    fName = Dir(fPath & "*" & num & ".docx")

    Do While fName <> ""
        Set doc = wd.documents.Open(fPath & fName)
        doc.PrintOut
        doc.Close
        fName = Dir()
    Loop

 End Sub

（β） 2015/07/13(月) 21:11

お邪魔します。

 wd.Quit
 か
 wd.Visible=true
 どちらかを追加しておいたほうがよい気がします。

（マナ） 2015/07/13(月) 21:29

 To マナさん

 おっしゃるとおりですね！　バックグラウンドで、見えない幽霊ワードがうようよ漂っていました。

 To ケイコさん

 プロシジャの終わり、End Sub の直前に wd.Quit をいれておいてください。

（β） 2015/07/13(月) 21:48

βさま、マナさま　ありがとうございます。

 両方とも印刷できました。

 ところで、もう一つ教えて頂きたいのですが
 指定範囲をA列からA～Gに広げたい場合は
 どこを変更したらいいですか？
 ダブルクリックの方は
 If Intersect(Target, Columns("A:G")) Is Nothing Then Exit Sub
 でできましたが、
 他方の方は…素人考えで　1の部分を1：7みたいに変えても
 エラーでした。
 お手数をお掛けしますが、
 よろしくお願いします。
（ケイコ） 2015/07/14(火) 06:12

 If Selection(1).Column > 7 Then Exit Sub

 これで試してみてください。

（β） 2015/07/14(火) 06:28

βさま　ありがとうございます。

 何度もすいませんが、
 意気揚々と職場に来てためしたのですが
 なぜか、職場でうまくいきません
 （マクロは有効になっています）
 検索先のフォルダ設定ですが
 C:\Users\ケイコ\Desktop\得意先一覧\得意先詳細
 という場合は
 fPath = CreateObject("WScript.Shell").SpecialFolders("C:\Users\ケイコ\Desktop\得意先一覧") & "\得意先詳細\"
 という感じでよかったでしょうか。
 何度も申し訳ありません。
（ケイコ） 2015/07/14(火) 08:07

 いえ、残念ながら違います。

 c:\Users\xxxx\DeskTop\hoge\ というフォルダがあったとします。

 この xxxx は　ＰＣのWindowsログインID で、ＰＣごとに異なります。
 なので、ここをハードコードにしておくと、他のＰＣでは存在しないフォルダになります。

 ですから、そのＰＣにあったデスクトップまでのパスにしなければいけません。
 そのパスを返してくれるのが

 CreateObject("WScript.Shell").SpecialFolders("Desktop") です。

 たとえば、ここを

 CreateObject("WScript.Shell").SpecialFolders("MyDocuments")  にすると、ドキュメントフォルダまでのパスが取得できます。

 いずれにしても、デスクトップにある "得意先一覧" の、その下の "得意先詳細" までのパスは

 CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\得意先一覧\得意先詳細\" になります。

（β） 2015/07/14(火) 08:38

βさま　ありがとうございます。

 丁寧な説明ありがとうございます。
 無事印刷できました。大変便利で作業効率が大幅にアップします！

 このマクロですが、他の職員にも使用させたいと思うのですが
 その場合、サーバーを利用しなければならないのですが
 サーバーの場所を指定することは可能でしょうか？
 関数や他のマクロでサーバーを利用しており問題ないのですが
 フルパスで指定する場合、
 CreateObject("WScript.Shell").SpecialFolders("Desktop") 
 この形で利用はできないでしょうか？

（ケイコ） 2015/07/14(火) 09:47

 サーバーの場合は、名前が決まっていますので、固定でコード記述してＯＫです。

 fPath = "\\サーバー名\hoge1\hoge2\hoge3\" といったように。

 もし「すべてのＰＣに」ネットワークドライブとして割り当てられているなら
 fPath = "Z:\hoge\" といったような指定もできますが、ＰＣによっては割り当てられていない、あるいは
 割り当てられたドライブが異なっっていれば（ＰＣによって X だったり G だったりすれば）この記述はできません。

（β） 2015/07/14(火) 10:25

βさま　ありがとうございます。

 なぜか、サーバーのアドレスを入れるとうごきません。
 デスクトップでは問題なく動くのですが…
 試しに同じアドレスでハイパーリンクを作成したら
 目的のフォルダは開くので
 アドレスは間違っていないはずですが…
 きっと私が何かヘマをしているのですね。
 もう少しいじってみます。
（ケイコ） 2015/07/14(火) 11:52

βさま　

 原因がわかりました。
 マクロもサーバーアドレスも問題ありませんでした。
 私がデスクトップで使用しているワードは　○○123の書式ですが
 サーバーで皆で使用しているのは　○○123○○
 という書式で通しナンバーの前後に文字列が入った状態だったのが原因でした。
 この書式では検索はできませんか？
 何度もすいません。
（ケイコ） 2015/07/14(火) 12:45

βさま

 できました！
 当てずっぽうで
  fName = Dir(fPath & "*" & num & "*"&".docx")
 で動かしてみましたらできました！
 色々お世話になりました。
 勉強になりました。
 ありがとうございました。

（ケイコ） 2015/07/14(火) 13:08

βさま

 何度も何度もすいません。
 皆で使用できるようになって大変便利なのですが
 そうすると色々注文がでまして
 いきなり印刷だと間違いが多いので
 印刷プレビューを出すか、ワードを開くまでにしてもらいたいのですが
 どこを直せばよいでしょうか？
 Set doc = wd.documents.Open(fPath & fName)
        doc.PrintOut
        doc.Close
        fName = Dir()
    Loop
 を
 Set doc = wd.documents.Open(fPath & fName)
        doc.PrintPreview
 や
        doc.Open
 ではできなかったのです（今度は素人考えでは無理でした）
 何度もストーカーのようですいません。
（ケイコ） 2015/07/14(火) 16:13

 doc.PrintPreview がきかないのは、ワードを、バックグラウンドで（非表示で）生成しているからで
 プレビュー画面も見えないということだろうと思います。

 なので、まず、生成したワードを表示してやる。これで１つ進みますが、お気づきかどうか、コードでは
 たとえば 234 関連が複数あれば、それらをすべて対象にして開いています。
 で、開かれた後のプレビューも、それらすべてのワードファイルに対して、表示ということで、タスクバーの
 各ワードを選択するとそれぞれのプレビュー画面がでています。

 これを見つかった最初のファイルだけとか、最後のファイルだけということもでしますが、以下はすべてを対象。

 で、ワードを読みこんでプレビューさせますから、コード内でのクローズとワードの終了は消しました。

 Sub Test3()
    Dim fPath As String
    Dim fName As String
    Dim wd As Object
    Dim doc As Object
    Dim num As String

    If IsEmpty(Selection(1)) Then Exit Sub
    If Selection(1).Column > 7 Then Exit Sub

    Set wd = CreateObject("Word.Application")
    wd.Visible = True

    fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Test\"

    num = StrReverse(Val(StrReverse(Selection(1).Value)))

    fName = Dir(fPath & "*" & num & "*.docx")

    Do While fName <> ""
        Set doc = wd.documents.Open(fPath & fName)
        doc.PrintPreview
        fName = Dir()
    Loop

 End Sub

（β） 2015/07/14(火) 17:37

βさま
　ありがとうございます。
　doc.PrintPreviewでよかったんですね。
　しかし、そもそも基本がないので、その前後の意味が
　分かっていなかったので…
　大変勉強になりました。
　本当にありがとうございました。
（ケイコ） 2015/07/14(火) 21:20

以前に解決したと思っておりましたが、追加の問題が出て…

 再度、教えて頂きたいことがあります。

 教えて頂いたマクロで3ケタの数の先頭又は語尾に0が入った場合
 0を抜いた2ケタの数字で検索してしまうようです
 例）110だと11が付く名前全てを開いています（11、111、112…）
 セルの書式を「文字列」に変更したりしてみましたが、解決できませんでした。
 何か良い方法はあるでしょうか。

 よろしくお願いします。
（ケイコ） 2015/07/27(月) 13:36

 確かに！！　ごめんなさい。（ぺこり）

 ちょっとインチキしましょう。

 num = StrReverse(Val(StrReverse(Selection(1).Value & 9)))
 num = Left(num, Len(num) - 1)

（β） 2015/07/27(月) 18:00

βさま

 ありがとうございます。
 そうですか…そこを変えるといいんですね…
 といっても、難しい過ぎてわかりません(^_^;)
 とにかく、おかげで、検索うまくいきました。
 ありがとうございました。
（ケイコ） 2015/07/28(火) 08:20

コメント返信：

[ 一覧(最新更新順) ]

[[20150713163729]] 『マクロで指定したセルの文字列の一部を参照し、別』（ケイコ） ページの最後に飛ぶ

[[20150713163729]]　『マクロで指定したセルの文字列の一部を参照し、別』（ケイコ）　ページの最後に飛ぶ