[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロで指定したセルの文字列の一部を参照し、別フォルダのワード文書を検索し印刷したい』(ケイコ)
よろしくお願いします。
ブックにお得意様名と通し番号がずらっとならんでいます 例)1セルに 海馬遊戯234 みたいな感じです (下3桁が通し番号になっています) 目的のお得意先セルをクリックし、マクロボタンを押したら 別フォルダ(仮にAAA)内に多数入っているワードの文書名から 通し番号を検索して、印刷できるようにしたいのです。 ワード文書のお得意先の名前は必ずしも一致せず、 番号だけが一致します(例では234) この可能でしょうか?
< 使用 Excel:Excel2010、使用 OS:Windows7 >
これを、わざわざエクセルで?
ワードを読みこむのに、どっこいしょという感じで、ちょっと重いですが。
マクロブックの Sheet1 の A列1行目から下に、xxx234 といったものが指定されているという前提。 またフォルダはデスクトップ上の "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 は PCのWindowsログインID で、PCごとに異なります。 なので、ここをハードコードにしておくと、他のPCでは存在しないフォルダになります。
ですから、そのPCにあったデスクトップまでのパスにしなければいけません。 そのパスを返してくれるのが
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
サーバーの場合は、名前が決まっていますので、固定でコード記述してOKです。
fPath = "\\サーバー名\hoge1\hoge2\hoge3\" といったように。
もし「すべてのPCに」ネットワークドライブとして割り当てられているなら fPath = "Z:\hoge\" といったような指定もできますが、PCによっては割り当てられていない、あるいは 割り当てられたドライブが異なっっていれば(PCによって 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 がきかないのは、ワードを、バックグラウンドで(非表示で)生成しているからで プレビュー画面も見えないということだろうと思います。
なので、まず、生成したワードを表示してやる。これで1つ進みますが、お気づきかどうか、コードでは たとえば 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
再度、教えて頂きたいことがあります。
教えて頂いたマクロで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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.