ワード+エクセルのマクロ

質問

めぐみと申します。
ワード+エクセルのマクロのことで質問させて頂きます。
少し複雑ですみません。

ワードに書いてある単語をエクセルの中に記載されてある辞書（A列の単語→B列の単語）を置換したいです。

対象ファイル：
1.ディレクトリ内にあるワードファイルすべてのワードファイル
2.エクセルファイル
　A列　検索対象の単語
　B列　置換対象の単語

動作：
エクセルのマクロを実行すると同じ階層にあるワードを探して、A列の単語の一覧を検索してB列に置換

エクセルのマクロを実行してワードのファイルの中の単語を変換するといった複雑なマクロは可能なのでしょうか？

恐れ入りますがご存じの方がいらっしゃいましたら教えて下さい。

回答No.5

qualheart · ベストアンサー

試してみましたがこちらではエラーは発生しませんね・・・
何が原因でエラーになっているか良く分かりません＾＾；

こちらではExcel2003の環境で検証しているので、バージョンによって違いがあるのかも知れません。
お役に立てずに申し訳ありません。

お礼

お手数をおかけして本当に申し訳ありませんでした。
2002で試していてできなかったのですが、アドバイス頂いてバージョンを2010で作動させましたところ無事マクロが動きました。
本当に真摯にお付き合い頂きましてありがとうございました。
めぐみ

回答No.4

qualheart

説明が悪かったですね＾＾；
以下の部分が間違ってます。

wdObj.Documents.Open ActiveWorkbook.Path & "C:\ExchangeMacro\Exchange.doc"
↓
wdObj.Documents.Open ActiveWorkbook.Path & "\Exchange.doc"

ActiveWorkbook.Pathが、エクセルファイルがあるフォルダまでのパスを示しているので、ActiveWorkbook.Pathを使う場合は"\Exchange.doc"のようにフォルダ区切りの\マークとWordのファイル名のみ指定してあげれば良いです。

ちなみにエクセルファイルがあるフォルダの中にあるすべてのWordファイルに対して実行したい場合は、以下でのような記述でOKです。
以下をコピーしてそのまま使えば動くと思います。

ご参考まで。

****************************************************

Sub ワードファイル翻訳()
Dim wdObj As New Word.Application
Dim buf As String
buf = Dir(ActiveWorkbook.Path & "\*.doc")

Do While buf <> ""

wdObj.Documents.Open ActiveWorkbook.Path & "\" & buf

n = 1
Do While ActiveSheet.Cells(n, 1) <> ""
fdtxt = ActiveSheet.Cells(n, 1)
rptxt = ActiveSheet.Cells(n, 2)

With wdObj.Selection.Find
.Text = fdtxt
.Replacement.Text = rptxt
.Forward = True
.Wrap = wdFindContinue
End With
wdObj.Selection.Find.Execute Replace:=wdReplaceAll

n = n + 1
Loop

buf = Dir()
Loop

wdObj.Quit
End Sub

お礼

すみません何度も・・・
教えていただいた下記のマクロプログラムやいろいろと試してみましたが同じエラーが出てきます。
------------------------------------
実行時エラー '-2147417851(80010105)':
オートメーションエラーです。
サーバによって例外が返されました。
------------------------------------

下記のマクロですがそちらでは正常に動いてますでしょうか？
****************************************************

Sub ワードファイル翻訳()
Dim wdObj As New Word.Application
Dim buf As String
buf = Dir(ActiveWorkbook.Path & "\*.doc")

Do While buf <> ""

wdObj.Documents.Open ActiveWorkbook.Path & "\" & buf

n = 1
Do While ActiveSheet.Cells(n, 1) <> ""
fdtxt = ActiveSheet.Cells(n, 1)
rptxt = ActiveSheet.Cells(n, 2)

With wdObj.Selection.Find
.Text = fdtxt
.Replacement.Text = rptxt
.Forward = True
.Wrap = wdFindContinue
End With
wdObj.Selection.Find.Execute Replace:=wdReplaceAll

n = n + 1
Loop

buf = Dir()
Loop

wdObj.Quit
End Sub

回答No.3

qualheart

＞参考URLの参照設定の情報

Microsoft Visual Basicの画面でツール→参照設定を選択し、「参照可能なライブラリファイル」の中で「Microsoft Word 10.0 Object Library」（または「Microsoft Word 10.0 Object Library」かも）をチェック。
これでOKです。

あと、コードについてですが、
wdObj.Documents.Open "Exchange.doc"のファイル指定は、Wordファイル名だけでなくフルパスとしてください。

Excelファイルと同フォルダにWordファイルがあるのであれば、
wdObj.Documents.Open ActiveWorkbook.Path & "\Exchange.doc"
でもOKです。

これでまず試してもらえますか？

お礼

有難うございます。
ご指示いただいた通り変更したつもりなのですが、
------------------------------------
実行時エラー '-2147417851(80010105)':
オートメーションエラーです。
サーバによって例外が返されました。
------------------------------------

というエラーが出てきてしまいます。
C:\ExchangeMacro\の中にExchange.docを置いて（エクセルファイルもこのディレクトリの中に入れました）下記のようにマクロを書いて実行しています。
エクセルファイルには
A列に検索する文字
B列には置換する文字
を2行ほど入れています。

------------------------------------
Sub ワードファイル翻訳()
Dim wdObj As New Word.Application
wdObj.Documents.Open ActiveWorkbook.Path & "C:\ExchangeMacro\Exchange.doc"

n = 1
Do While ActiveSheet.Cells(n, 1) <> ""
fdtxt = ActiveSheet.Cells(n, 1)
rptxt = ActiveSheet.Cells(n, 2)

With wdObj.Selection.Find
.Text = fdtxt
.Replacement.Text = rptxt
.Forward = True
.Wrap = wdFindContinue
End With
wdObj.Selection.Find.Execute Replace:=wdReplaceAll

n = n + 1
Loop

wdObj.Quit
End Sub

------------------------------------
お忙しいところ大変恐れ入りますがお手すきの時に見ていただくと大変助かります。
よろしくお願いいたします。

回答No.2

qualheart

＞A列から取得した文字列をWord文書内で検索してB列の文字列に置換するマクロ

以下を参考にしてみてください。
ただし、ディレクトリ内にあるワードファイルすべてを対象にするには、フォルダ内のWordファイルのリストを取得して以下のコードを各Wordファイルごとに実行するような形に変える必要があります。

あと、Excel上でWordのメソッドを実行するには、あらかじめVBAの参照設定で「Microsoft Word x.0 Object Library」を参照させておく必要があります。
それについては、参考URLを参照してみてください。

ご参考まで。

*********************************************

Dim wdObj As New Word.Application
wdObj.Documents.Open "Wordファイル名"

n=1
Do While Activesheet.Cells(n, 1) <> ""
fdtxt = Activesheet.Cells(n, 1)
rptxt = Activesheet.Cells(n, 2)

With wdObj.Selection.Find
.Text = fdtxt
.Replacement.Text = rptxt
.Forward = True
.Wrap = wdFindContinue
End With
wdObj.Selection.Find.Execute Replace:=wdReplaceAll

n = n + 1
Loop

wdObj.Quit

参考URL：

http://www.simple-sys.com/blog/2008/03/29/172/

お礼

ご丁寧にありがとうございます！
下記のようにマクロを実行していますが動きません。
実は教えていただいた参考URL：http://www.simple-sys.com/blog/2008/03/29/172/
が私が住んでいる国（中国）から見ることができません。
恐らくこの部分が原因だと思います。
エクセルは2002年版（XP版）を使用していますがどのようにすればよいか教えて頂けないでしょうか。
何度も大変恐れ入りますが何卒よろしくお願いいたします。

Sub ワードファイル翻訳()
Dim wdObj As New Word.Application
wdObj.Documents.Open "Exchange.doc"

n = 1
Do While ActiveSheet.Cells(n, 1) <> ""
fdtxt = ActiveSheet.Cells(n, 1)
rptxt = ActiveSheet.Cells(n, 2)

With wdObj.Selection.Find
.Text = fdtxt
.Replacement.Text = rptxt
.Forward = True
.Wrap = wdFindContinue
End With
wdObj.Selection.Find.Execute Replace:=wdReplaceAll

n = n + 1
Loop

wdObj.Quit
End Sub

回答No.1

qualheart

可能ですね。
エクセル上のマクロにWordマクロを使用するような記述をすれば良いです。

マクロの最初に
Dim wdObj As New Word.Application
という宣言を入れれば、このwdObjというオブジェクトを指定して、エクセルのマクロ上でWord用のメソッドを実行するような記述ができます。

例えばエクセルマクロからWord文書を開きたければ、
Dim wdObj As New Word.Application
wdObj.Documents.Open ファイル名
のようにエクセルマクロ上に書けば良いわけです。

まあこれと同じように、A列から取得した文字列をWord文書内で検索してB列の文字列に置換するマクロを、エクセルマクロ上に書けばOKです。

ご参考まで。

お礼

qualheartさま

可能だということがわかり安心しました。
”A列から取得した文字列をWord文書内で検索してB列の文字列に置換するマクロ”
って簡単でしょうか。
もし良ければ教えて頂けないでしょうか。
厚かましい内容を書いてしまい大変申し訳ありません。
もし、お時間があればで結構なのですがぜひよろしくお願い致します。
めぐみ