みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Word2007 文字変換マクロについて

以下のvbsファイルがエラーなってしまいます。
どう直したらよいかご教授お願いします。(マクロ初心者)

Const wdReplaceAll = 2

Set objWord = CreateObject("Word.Application")
objWord.Visible = False

Set fs = CreateObject("Scripting.FileSystemObject")

Set objFolder = fs.GetFolder("D:\test")

For Each objFile in objFolder.Files
If Right(LCase(objFile.Name), 5) = ".docx" Then
Set objDoc = objWord.Documents.Open(objFolder.Path & "\" & objFile.Name)
Set objSelection = objWord.Selection

' objSelection.Find.Text = "A"
' objSelection.Find.Forward = True
' objSelection.Find.MatchWholeWord = True
' objSelection.Find.Replacement.Text = "B"

'----------------------------------------------------------
Open "D:\test\2.csv" For Input As #1
While Not EOF(1)
Line Input #1, a
s = Split(a, ",")
MsgBox s(0) & " " & s(1)

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
'----------------------------------------------------------
objSelection.Find.Text = s(0)
objSelection.Find.Forward = True
objSelection.Find.MatchWholeWord = True
objSelection.Find.Replacement.Text = s(1)
'----------------------------------------------------------
objSelection.Find.Wrap = wdFindContinue
objSelection.Find.Format = False
objSelection.Find.MatchCase = False
objSelection.Find.MatchWholeWord = False
objSelection.Find.MatchByte = False
objSelection.Find.MatchAllWordForms = False
objSelection.Find.MatchSoundsLike = False
objSelection.Find.MatchWildcards = False
objSelection.Find.MatchFuzzy = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Wend
Close #1
End Sub
'----------------------------------------------------------

If objSelection.Find.Execute( ,,,,,,,,,,wdReplaceAll) Then
objDoc.Save
End If
objDoc.Close
End If
Next

objWord.Quit

投稿日時 - 2009-10-14 18:50:15

QNo.5367096

すぐに回答ほしいです

質問者が選んだベストアンサー

こんばんは。

Wordマクロは、記録マクロでは書けない部分がありますので、結局のところ、教わらないと無理だと思うのです。それと、私の感覚的なものですが、Word 2003 以上は、開発者に、ユーザー配慮の縛りが少ないせいか、新しい方法をどんどん取り入れているようです。それが、開発者には、さっぱり分からないところが出てきています。MSDNでも、Word 2003 までのオブジェクト・リストはあるのですが、その後がありません。公開してくれていないのです。

>3.置換した文字列を
>  (1)ゴシックフォントにする。
>  (2)ブルー色にする。
>  (3)アンダーラインを付ける。

早い話、コードを見ていただければ分かるはずです。もし、自力で思いつくようなら、相当の勘の良い人か、Try & Error の繰り返しでしかありません。

それと、もしご興味がおありになるようでしたら、いくつか、こうしたコードの開発についての補足情報を次の書き込みに書いておきます。こういう開発は、Excel VBAとは違うものです。ただし、以下のコードが通らなければ、次に書く意味などありませんが。

'-------------------------------------------
'マクロ終了後、最初は、必ず、タスクマネージャで、WINWORD.EXE が残っていないか確認のこと
'================
''WordReplaceR.vbs 091016
'=================
''ユーザー設定
'末尾に'\'は付けないでください。Don't add delimiter '\' to the last folder name
Const mFOLDER = "D:\test"
Const csvFILE = "2.csv"
Const sEXT = ".docx"
'-------------------------------------------

Const wdReplaceAll = 2
Const wdFindContinue = 1
Dim Ar()
Dim objWord
Dim fName
Dim objFolder
Dim cnt
cnt = 0

Set objWord = CreateObject("Word.Application")
Set fs = CreateObject("Scripting.FileSystemObject")

If fs.FileExists(mFOLDER & "\" & csvFILE) Then

Set objFolder = fs.GetFolder(mFOLDER)

Call PickUpWord

If Ar(0, 0) <> "" Then
On Error Resume Next
For Each objFile in objFolder.Files
If Right(LCase(objFile.Name), Len(sEXT)) = sEXT Then
'チェック用
'MsgBox objFile.name
Call WordExe (objFolder.Path & "\" & objFile.Name)
End If
Next
End If
objWord.Quit
Set fs = Nothing
Set objWord = Nothing
If Err.Number > 0 Then
MsgBox Err.Description,48,"Error!"
Else
MsgBox cnt & " 個処理済み。正常終了しました。",64,"終了メッセージ"
End If
On Error Goto 0

Else
MsgBox "環境的に条件が違いますので、一度ファイルを確認してください。",48
End If

'!!Here is the End of Program.
'-------------------------------------------
Sub PickUpWord()
Dim f, i, j
Dim sLine
Dim txes

i = -1
Set f = fs.OpenTextFile(mFOLDER & "\" & csvFILE)
Do Until f.AtEndOfStream
tmpLine = f.ReadLine
txes = Split(tmpLine, ",")
i = i + 1
Redim Preserve Ar(1, i)
If Ubound(txes)>0 Then
Ar(0,i) = txes(0)
Ar(1,i) = txes(1)
Else
Ar(0,i) = txes(0)
Ar(1,i) = ""
End If
Loop
End Sub

Sub WordExe(fName)
Const MYCOLOR = &HFF0000
Dim j
cnt = cnt + 1

objWord.Visible = False

Set objDoc = objWord.Documents.Open(fName)
Set objSelection = objDoc.Application.Selection
'チェック用
'MsgBox fName & " :" & cnt

With objSelection.Find
For j = Lbound(Ar,2) To Ubound(Ar,2)
.ClearFormatting
.Replacement.ClearFormatting
.Text = Ar(0, j)
.Forward = True
.MatchWholeWord = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = True
With .Replacement
.Text = Ar(1, j)
.Font.Color = MYCOLOR
.Font.Name = "MS ゴシック"
.Font.Underline = 1
End With
ret = objSelection.Find.Execute(, , , , , , , , , , wdReplaceAll)
Next
End With
objDoc.Save
objDoc.Close
End Sub

投稿日時 - 2009-10-16 22:29:51

お礼

Wendy02さん、ありがとうございました(._.)

しばらく不在でしたのでお礼の書き込みが遅くなり申し訳ありませんm(__)m

これで何とかなります。
すべてを理解することは現在の私にできませんが、少しずつ解明してどのようになっているか理解を進めます。

こんなことまでできるとは思っていなかったものですからとても感謝しています。すべてを回答いただいて感激しています。

何度もていねいに教えていただいて本当ありがとうございましたm(__)m

投稿日時 - 2009-10-26 09:23:07

ANo.7

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(9)

ANo.9

それは良かったです。

今回は、VBAをたしなむ人がみれば大したことがないと思うかもしれませんが、Wordマクロではなくて、Wscript(WSH)という分野ですから、VBAマクロよりも1ランク上です。今回の開発では、VB6の開発と同じように、Winword.exe の常駐を絶対に残さないということが大事です。

それとExcelのSDI(Single Document Interface)の設定をしても、WordのSDIとはまったく挙動が違うのです。VBAだけの人は、これに気が付きません。これが、VB.Net になると、もっと難しくなります。

Word VBAは、基本的なことは、『Office 97 プログラマーズガイド』の中のWord編を読みましたが、どちらかというと、Webサイトのサンプルコードを一つずつ調べて覚えたものが多いです。WScript用のエディタがあると良いのですが、今、私は、"VBSedit" というツールの旧版しか持っていません。新しいものがあると良いなって思っています。

WScript は、昔と違って、WMIやHTAがありますので、半端でなく難しいです。その割りに、教本テキストが少ないし専門的なものが多いです。おまけに、Vista では、その言語のサポートがおかしくなっています。Microsoft 側では、PowerShell という別の開発言語に仕向けたいようです。

それと、少し言い訳させていただくと、質問の最初から全体的な組み立てが分かれば、自分が出来るか出来ないかの判定が出来ます。内容によっては、追加条件によってまったく違う内容にもなることがあります。全体のコードの中のたった一行でもクリアできなければ、全体が動きません。いくら努力賞で点を貰っても、それでは何にもならないのです。それだけに、掲示板で書くのは、自己満足だけではいけないので、難しいものだなって思います。それが現在の私の唯一のトレーニング方法です。

投稿日時 - 2009-10-26 19:25:40

お礼

 Wendy02さん、ていねいに最後までフォローしていただき感謝します。

 そうなんですか。Wordマクロに毛がはえたつもりで始めてしまいました。奥が深いのですね。Excelの式だけは自信があったのですがすが、Wscriptはマクロよりかなり難しいことが分かりました。山は高いほど登りたくなんていえるほど力を付けたいものです。

 Wscript(WSH)という言葉を初めて知りました。今後は、Wscriptで検索し知識を深めていきたいと思います。

 最後のフォローを読んで、Wendy02さんの苦労の再認識と回答の素晴らしさに納得しました。

 このあと質問を締め切りますのボタンを始めてクリックしてみます。

 ありがとうございましたm(__)m

投稿日時 - 2009-11-04 14:49:50

ANo.8

こんにちは。

すでに一週間を過ぎましたが、もうそろそろ、大幅な改編をするような書き換えは難しくなりますので、#7 のコードは問題がありましたら、なるべくお早めに、ご指摘ください。勝手を言って申し訳ありませんが、もし、大幅な改編が必要だと思われる場合は、新たな質問を起こしていただいた方がよいです。

投稿日時 - 2009-10-24 10:21:12

お礼

Wendy02さん、おはようございます

さっそくやってみました。もちろん、中を見てこれならできる、しかもやりたかったアンダーラインや青字まで設定されていることも確認しました上でやりました。

RUNすると、Wordが自動的に起動し、docxファイルが一つずつ開かれて実行されている様子が見え、最後に「3個処理済。正常処理しました」と表示が出ました。Wordも閉じました。

結果を見ていると、完璧に複数のファイルを開いて、複数の置換を実行しかつ他の文字列には影響を与えていません。完璧です。

素晴らしい(^^)v
実は、私はマクロは難しいと避けて来たので、計算式は分かるのですがマクロは食わずきらいでした。今回のアドバイスでマクロも使ったほうがいいと分かりました。

Wendy02さん、お礼とテストが遅れたこと申し訳なく思います。
質問の仕方をシンプルに・追加はしない旨のアドバイスをいただきありがとうございました。
この質問、しばらくしたら完了にします。助かりました。

p.s.
文字列の間に、全角スペース・半角スペースが有ってもやってくれるのですね。完璧に置換されていました。いつも手で一つ一つやっていた苦労がうそのようです。ありがとうございましたm(__)m

投稿日時 - 2009-10-26 09:54:39

ANo.6

こんにちは。

#2のお礼の部分を読みました。
まあ! ちょっと驚いています。

>1.数百のWordファイルをマクロで順次開く。
>2.文字列を置換する。
>3.置換した文字列を
>  (1)ゴシックフォントにする。
>  (2)ブルー色にする。
>  (3)アンダーラインを付ける。

これを、ご自身で作ろうと思ったのですか?VBAの初心者といいながら、ある程度、腕に覚えがあるからだとは思いますが、みなさん、Wordマクロを甘く見る人がほとんどです。Wscript は、ワンランク上の知識と経験が必要です。元のコードは、エラーが発生するというよりも、全体の構成自体がWScript 用には出来ていないようです。

ところで、私は、ここでの回答のポリシーは、後だしの条件をあまり数多く盛りいれるということはしておりません。後で、何度も出てくるようですと、不本意ですが、お答え出来なくなるかもしませんので、もし、なんら条件が加わるようでしたら、どうぞ、あらかじめ出しておいてください。

置換が2行以上にわたるものは、メインの部分が書き換えになります。

よろしくお願いします。

投稿日時 - 2009-10-16 10:27:02

お礼

Wendy02さん、書き込みが遅くなりました。
実はNo.6に一度お礼を書き込んだのですが、未熟で書き込みが完了
しなかったようです。遅くなりました。

>1.数百のWordファイルをマクロで順次開く。
>2.文字列を置換する。

申し訳ありません。誤解を生む書き込みをしてしまいました。
教えていただきたいのは、1.と2.です。1.でフォルダ
内のdocxファイルを一つ読み込んでは、2.の複数行ある
置換文字列を処理しファイルを保存する。また次のdocxファ
イルを読み込んで2.の処理です。当初書き込みましたマクロ
は、外側でファイルを次々と読み込み、内側で複数ある置換を
次々と処理するマクロのつもりです。当初お願いしたかったに
追加したわけではありません。

3.につきましては、自分で何とかしよう思っていて追加した
わけではありません。言葉足らずで申し訳ありません。

書き込みいただきましたマクロは見事RUNしました。あとは
複数の処理ができれば完成します。

何とぞご教授宜しくお願いいたします。

投稿日時 - 2009-10-16 19:46:27

ANo.5

#3の回答者です。

今、#1のお礼の部分を読んで、間違いに気がつきました。

>D:\testフォルダ内のすべてのWord2007ファイルを順次開いて、
>A,B
>C,D
>を入力した

順次、置換するのですか?それは、ちょっと面倒ですね。
#3のコードは、1対1の対応しかしません。

Sub PickUpWord() で、2.csv を複数行に対応させることと、
Sub WordExe(tx1, tx2, fName) の内部をループさせることにします。

ただ、一応、ご質問者さんの反応を見てからにします。
なお、エラーは、VBScript 上のエラーは行等の情報が出ますが、今回の場合は、オートメーション・オブジェクトですから、その内部エラーについては、まったくと言っていいほど分かりません。

投稿日時 - 2009-10-15 18:55:47

お礼

Wendy02さん、書き遅くなり申し訳ありません。

Sub PickUpWord() で、2.csv を複数行に対応させることと、
Sub WordExe(tx1, tx2, fName) の内部をループさせること

分からない点はこの2点です。
ご教授いただきますよう宜しくお願いいたします。

p.s.
マクロひとつだけ作ったことがあります。
Excelの指定ファイルを読み込んでくっつけるという単純な
マクロです。

手作業でやろうかと思っていましたら、ネットでたまたま
.vbsが使えると分かって事例で出ていた2つのマクロを
くっつけました。分かってくっつけたわけではありません
のでどう直したらよいか分からず途方にくれて、この掲示版
で初めて質問した次第です。申し訳ありません。

投稿日時 - 2009-10-16 19:31:42

ANo.4

ちなみに「マクロ初心者」ということでしたら、VBSでもOption Explictは有効なので付けて置いた方がいいでしょう。

ただ、もしVBAでもエラーの原因特定に苦労されているとしたら、もっとエラーを特定しにくいVBSでは長いコードは避けたほうがいいでしょう。

VBSではデバッグ環境はありませんし、たとえエラーがなくても分岐条件のミスで単にエラー部分をすり抜けているだけといったこともあります。
当面はVBAで対応されることをお勧めします。

投稿日時 - 2009-10-15 15:31:05

お礼

cistronezkさん、お礼が遅くなりました。

見通しが付きましたら、
Option Explict
追加してみます。
アドバイスありがとうございました。

投稿日時 - 2009-10-16 19:53:21

ANo.3

こんにちは。

細かい間違いがあっても、エラーが出ますし、VBScriptは、どこに間違いがあるか、すぐに分からない部分があります。どんなエラーかという内容などいりません。最初から最後まで、エラーなく通ればそれで良いとは思います。ただ、以下のコードは、エラー解除が完全に行われているとは限りません。チェック用と書いてあるのは、ローカルウィンドウなどありませんので、要所で、ストップを入れています。

出来れば、WordのVBAのアドイン化したほうが楽かもしれません。なお、最後に、エラーは返すようにしました。

それと、2.csv ファイルは、どちらかというと、ini ファイルなど、別の名称のほうが良いかもしれません。ただ、手元に参考テキストもないので、2.csvに、2行以上あるなどの問題に対するチェックされていません。

一応、以下は、オートメーション・オブジェクトを残っていないようですが、一度は、必ず、タスクマネージャで、WINWORD.EXE が残っていないか調べてみてください。

'-------------------------------------------
'注意:全角空白は、絶対に入れないでください。

'================
''WordReplace.vbs
'=================
Const wdReplaceAll = 2
Const mFOlDER = "D:\test"
Const csvFILE = "2.csv"
Const sEXT = ".docx"
Dim tx1, tx2
Dim objWord
Dim fName
Dim objFolder
Dim cnt
cnt = 0

Set objWord = CreateObject("Word.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
Set objFolder = fs.GetFolder(mFOlDER)

Call PickUpWord

If tx1 <> "" Then
On Error Resume Next
For Each objFile in objFolder.Files
If Right(LCase(objFile.Name), len(sEXT)) = sEXT Then
'チェック用
'MsgBox objFile.name
Call WordExe (tx1, tx2, objFolder.Path & "\" & objFile.Name)
End If
Next
End If
objWord.Quit
Set fs = Nothing
Set objWord = Nothing
If Err.Number >0 Then
MsgBox Err.Description,48,"Error!"
Else
MsgBox cnt & " 個処理済み。正常終了しました。",64,"終了メッセージ"
End If
On Error Goto 0

'!!Here is the End of Program.
'-------------------------------------------
Sub PickUpWord()
Const ForReading = 1
Dim f
Dim sLine
Set f = fs.OpenTextFile(mFOLDER & "\" & csvFILE, ForReading, True)
sLine = f.ReadLine()
s = Split(sLine, ",")
'MsgBox s(0) & " " & s(1)
tx1 = s(0)
tx2 = s(1)
End Sub


Sub WordExe(tx1, tx2, fName)
cnt = cnt + 1
Const wdFindContinue =1

objWord.Visible = False

Set objDoc = objWord.Documents.Open(fName)
Set objSelection = objDoc.Application.Selection

'チェック用
'Msgbox fName & " :" & cnt
With objSelection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = tx1
.Forward = True
.MatchWholeWord = True
.Replacement.Text = tx2
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = True
End With
ret =objSelection.Find.Execute(, , , , , , , , , , wdReplaceAll)
If ret Then
objDoc.Save
End If
objDoc.Close
End Sub

投稿日時 - 2009-10-15 14:23:54

お礼

Wendy02さん、貴重な回答ありがとうございます。道が開けました。

内容を見て問題なく動くと思って、VBSファイルに貼り付けて実行してみましたところ、自動的にWordファイルが開いて処理され正常に終了しました。

Wordファイルを開いて確認してみましたところ、2.csvファイルの一番目の行(A,B)しか処理されていません。二番目の行以降(C,D)も処理するにはどこをどのように直したらよいでしょうか。宜しくお願いいたします。

2.csvの内容
A,B
C,D
E,F

2.csvのcsvは、txtでいいと思っています。アドバイスありがとうございました。

投稿日時 - 2009-10-16 09:36:54

ANo.2

回答1です。
VBScriptだったのですね。VBと違っていろいろ制限があります。

VBSCriptではファイル操作コマンドはに
>Open "D:\test\2.csv" For Input As #1
とかは使えなかったと思います。
Scripting.FileSystemObjectを使ってください。
http://www.atmarkit.co.jp/fwin2k/operation/wsh10/wsh10_01.html

また、名前つきパラメータも指定できません。
>Selection.Find.Execute Replace:=wdReplaceAll
これもエラーになります。引数の順番を意識して指定する必要があります。

Wordのマクロからの転用と思われますが、WordのVBAをそのまま使用するのはだめなのでしょうか。

投稿日時 - 2009-10-15 11:26:57

お礼

お礼が遅くなりました。cistronezkさん、ありがとうございます。
まだ知識不足で前半の意味は分かりませんでしたが、少しずつ理解を深めたいと思っています。

WordのVBAは、そのファイルで実行すると思っています。
VBSファイルを使えばファイルをまとめて処理できるので使ってみることにしました。(VBAのレベルは初心者です。)

目的は
1.数百のWordファイルをマクロで順次開く。
2.文字列を置換する。
3.置換した文字列を
  (1)ゴシックフォントにする。
  (2)ブルー色にする。
  (3)アンダーラインを付ける。
です。

手で直すとどうしても漏れが出てしまいます。機械的に直すと直したくない文字列が出てきますので、置換した文字列に印(3.)を付けてあとで確認したいと思っています。

投稿日時 - 2009-10-16 09:23:07

ANo.1

どの行でどういうエラーが出ているのですか?

投稿日時 - 2009-10-14 21:20:16

お礼

恐縮です。あわてて書きこんだものですから言葉足らずでした。
申し訳ありません。

状況としては、
上記マクロをD:\test\test.vbsに作成しRUNすると、

スクリプト:D:\test\test.vbs
行: 21
文字: 22
エラー: ステートメントの末尾が不正です。
コード:  800A0401
ソース:  Microsoft VBScriptコンパイルエラー
のメッセージがでます。
たぶんOpenのところでエラーになっていますが、どう直したら
よいか分かりません。

このマクロは
objSelection.Find.Text = "A"
・・・・
objSelection.Find.Replacement.Text = "B"
で正常に動くことを確認した上で、
Open "D:\test\2.csv" For Input As #1
・・・・
Close #1
End Sub
を挿入しRUNして見ました。

目的としては、
D:\testフォルダ内のすべてのWord2007ファイルを順次開いて、
A,B
C,D
を入力した
D:\test\2.csv
を読み込み置換しWord2007ファイル保存することです。
(End Subは余分です)

どのように直したら処理できるでしょうか。
D:\test\2.csv
を読み込んでから、順次ファイルを開いたほうが効率的だと
思うのですが、マクロ経験がほとんどないのでそのつど
D:\test\2.csv
を開いて処理する方法にしました。どちらの方法でもかまいせん。
処理ができるといろんなWordのファイルをまとめて、置換パータン
を変えて処理できるとても便利なマクロになります。

どうぞ宜しくお願いいたします。

投稿日時 - 2009-10-15 10:08:12

あなたにオススメの質問