Wordマクロでテキストボックス内を含み英数半角・カタカナ全角変換する方法

Word2003でメイン文書（テキストボックスが多い）とヘッダー/フッタ付き文書（比較的ページ数が多い）で、(1)英数全角文字と一部の全角記号（「，」と「－」と「．」）を半角に、(2)半角カタカナを全角に変換しています。
現在の作業方法は、検索のオプションで「ワイルドカード」を使用したパターン検索を行い、それぞれ「メイン文書」「メイン文書内テキストボックス」「ヘッダー/フッター」領域を検索し、「文字種の変換」で上記(1)(2)の変換をしています。
この作業を「マクロの記録」を使って、マクロを作成し、効率化しようと色々と試しましたが、マクロの知識がまったくないせいか、それとも「記録」機能の限界なのか「エラー」がでて、うまくいきませんでした。
そこで、このサイトで「QNo.1479314」（2005年6月）で二人の方がマクロを紹介していたので、試用させていただきましたが、通常の文書内は問題ないのですが、テキストボックス内、ヘッダー/フッター内は変換されないようでこまりはてています。
上記(1)、(2)の一括変換（英数文字は一部の記号を含む）がテキストボックスを含んで（ヘッダー/フッターは除いても可）できるマクロを教えていただけると、大助かりなのですが・・・・。

よろしくお願いします。

No.9 ベストアンサー 回答者： Wendy02 回答日時： 2006/09/26 18:37

makuro786様

こんばんは。Wendy02です。

予想していないことがいくつかあり、ながらく引き伸ばして住みませんでした。かなり大きなマクロになってしまったと思いました。

これも、また同じ場所のモジュールのところにおいてください。
できれば、Normal.dot ファイルの同じ標準モジュールに置けば、常に使えるようになるかと思います。それを、ボタンなどに登録すれば、便利かと思います。

こんばんは。Wendy02です。

予想していないことがいくつかあり、ながらく引き伸ばしてすみませんでした。かなり大きなマクロになってしまったと思いました。

これも、また同じ場所のモジュールのところにおいてください。
できれば、Normal.dot ファイルの同じ標準モジュールに置けば、常に使えるようになるかと思います。それを、ボタンなどに登録すれば、便利かと思います。

Sub MainMacro()
'統合・全角半角変換マクロ
　Application.ScreenUpdating = False
　Call Zen2Han2
　Call CheckinShapes2
　Call HeaderFooter2
　Call CheckinToolBoxesR
　Selection.HomeKey Unit:=wdStory
　Application.ScreenUpdating = True
　Beep
End Sub

その処理する順番に決まりはありませんが、コントロールツールのテキストボックスを最後にしました。

この回答へのお礼

Wendy02様
こんばんは。makuro786です。

「統合」のマクロ作成ありがとうございました。このマクロを追加して、ボタンもメインメニューに作りました。
まったく問題なく作動しました。感謝感激です。
Wendy02さんの開発されたマクロのおかげで、作業効率がぐっと上がってとても文章の校正が楽になりそうです。これから有効に活用させていただきます。
思えば9月20日に投稿してから、実働7日間で完成に至ることができたのは、私の的外れの対応にもかかわらず、Wendy02さんの的確ですばやい対応のおかげと思っています。このマクロの開発にはお忙しい中、相当時間を裂かれたことでしょう。本当にお疲れ様でした。
なんとお礼を言ってよいのか、適当な言葉が見つかりませんが、とにかく本当にありがとうございました。
いつの日かまたお世話になることがあるかも知れませんがそのときはまたよろしくお願いします。

お礼日時：2006/09/26 22:54

No.10 回答者： Wendy02 回答日時： 2006/09/26 23:59

makuro786様

こんばんは。Wendy02です

#9の文章、ちょっとヘンでした。夏の疲れがどっと押し寄せている状態で、日中、意識がどこかに行っている時があります。

>いつの日かまたお世話になることがあるかも知れませんがそのときはまたよろしくお願いします。

実は、私は、Wordのマクロは、常に作っているわけではないので、勘が戻るまでに、かなりの時間が掛かって、今回は、最後まで戻っていなかったというのが、本音のところです。（そんな言う資格があるかは分かりませんが、こんな私でも、Wordマクロの迷宮入りを何個も解決した調子の良かった時はあるのです。)

しかし、Excelほどにやってはいないし、今は、.Net に移りつつあるので、だんだん、遠ざかっている状態に近くなっています。よく、最後まで、投げ出さないで、お付き合いくださって、こちらこそ、お礼申し上げます。ここでは、私のレスの場合で、1年間でみて、統計的に約3割の方は、途中でリタイアされます。だから、かなり腕に自信のある方でも、回答者の方は長続きしません。常に、書き込みが無駄になる不安の中で書いています。

元々、最初、私の思い込みから、その方針の立て方が、甘かったのです。だから、途中、変な振り回し方になって、申し訳ありませんでした。

今の私の心境は、ここの回答のすべて終わったような気持ちです。（本当です)^^;　たぶん、次は次であるのでしょうけれども……。

この回答へのお礼

Wendy02様
こんばんは、makuro786です。

>今の私の心境は、ここの回答のすべて終わったような気持ちです。（本当です)^^;　

この言葉に安心しました。Wendy02さんの達成感のような気持ちが伝わってきました。
実は、的外れな質問や問題の指摘ばかりして、回答を投げ出されるのではないかと、ひやひやものでした。また次から次へと出される宿題？にこちらも戸惑いながらなんとか対応していたというのが実情です。
今、私も望んでいたマクロが完成して達成感を感じているところです。
今日、Wendy02さんに設計して頂いたマクロは、実際の文書に組み込んで実行テストを行っています。関係者の評価も上々です。そして近いうちに、テンプレート文書に組み込む方向で、準備を進めているところです。
重ね重ね、御礼申し上げます。ありがとうございました。

お礼日時：2006/09/27 21:14

No.8 回答者： Wendy02 回答日時： 2006/09/25 19:33

makuro786様

こんばんは。Wendy02です。

これは、#6 そのままですが、「本文用の置換マクロ」です。昨日のコードと、その同じ場所に貼り付けてください。#3で書いたものは、すべて消しておいたほうが誤動作がなくてすみます。

どうやら、ここまでくれば、問題はないようですから、気をもませて申し訳ありませんでしたが、一応、すべて、「想定内^^;」に入りました。

Sub Zen2Han2()
'本文・全角半角変換マクロ
　Hankaku2Zenkaku Chr(161), Chr(223) '。-゜
　Zenkaku2Hankaku ChrW(&HFF10), ChrW(&HFF5A)　'０ - ｚ
　Zenkaku2Hankaku ChrW(&HFF0C), ChrW(&HFF0E) '，- ．
　Selection.HomeKey Unit:=wdStory '文書の先頭に
End Sub

>「ANo.4」のコードを今回のコードをそのままあとにつづけても、本文の英数・半角は変換されません
No.4 は、テキストボックス用の半角・全角置換マクロです。

まとめますと、

#8 のコード　（本文用－#7 で使ったコードを流用します)....今回のコード
名前：Zen2Han2

#7 のコード　(オートシェイプ・ヘッダー・フッター用)
名前：CheckinShapes2
名前：HeaderFooter2

#4 のコード　(コントロールのテキストボックス用)
名前：CheckinToolBoxesR

今は、バラバラにはなっていますので、それぞれで処理をします。一応、これでパスしたら、統合化します。

この回答への補足

こんばんは。makuro786です。
バッチリＯＫでした。
テスト文書に指示通りにマクロを組み合わせ、それぞれのマクロを順番に実行させました。
結果は全てOKです。
難産でしたが、うまくいって感激のひとことです。
お礼はあとで「お礼」の欄にゆっくり書かせて頂きます。
あとは「統合化」を是非よろしくお願いします。

補足日時：2006/09/25 20:47

No.7 回答者： Wendy02 回答日時： 2006/09/24 21:28

こんはんは。

すみません。見切りで掲示させていただきます。以下は、単独のコードですが、もし、ブックを新しくしていたら、こちらを、入れてしまってください。

テキストボックスと、ヘッダー・フッター分です。最後に、本文用のものを、このレスの後に続けます。

もし、元のブックのものでしたら、混乱しているようでしたら、今までのものは、全部削除してしまってください。その上で、#4 のテキストボックス用にコードを貼り付けてください。

統合用のマクロは、一番、最後に出します。


'----------------------------------------------
'標準モジュール

Sub CheckinShapes2()
'テキストボックス(オートシェイプ)
Dim shp As Shape
Dim buf As String
　For Each shp In ActiveDocument.Shapes
　 shp.Select
　 Hankaku2Zenkaku Chr(161), Chr(223), True '。-゜
　 Zenkaku2Hankaku ChrW(&HFF10), ChrW(&HFF5A), True　'０ - ｚ
　 Zenkaku2Hankaku ChrW(&HFF0C), ChrW(&HFF0E), True '，- ．
　Next shp
　End Sub
Sub HeaderFooter2()
'ヘッダーフッター
Dim wn As Variant
Dim buf As String
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
　 ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
　 ActivePane.View.Type = wdOutlineView Then
　 ActiveWindow.ActivePane.View.Type = wdPrintView
End If
　For Each wn In Array(wdSeekCurrentPageHeader, wdSeekCurrentPageFooter)
　ActiveWindow.ActivePane.View.SeekView = wn
　 Hankaku2Zenkaku Chr(161), Chr(223), True '。-゜
　 Zenkaku2Hankaku ChrW(&HFF10), ChrW(&HFF5A), True　'０ - ｚ
　 Zenkaku2Hankaku ChrW(&HFF0C), ChrW(&HFF0E), True '，- ．
　Next
　ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
　End Sub


Private Sub Hankaku2Zenkaku(ch1 As String, Optional ch2 As String, Optional blnShp As Boolean)
　'全角へ
　Dim myMsg As String
　Dim mWhat As String
　If blnShp = False Then
　 Selection.HomeKey Unit:=wdStory '文書の先頭に
　End If
　'ch1 = Chr(161) '半角の「。」,　'ch2 = Chr(223) '半角の「゜」
　On Error GoTo Errmsg:
　With Selection.Find
　　.ClearFormatting
　　.Text = ""
　　.Replacement.Text = ""
　　.MatchFuzzy = False
　　'設定をクリア
　If ch2 <> "" Then
　　　mWhat = "[" & ch1 & "-" & ch2 & "]{1,}"
　　Else
　　　mWhat = ch1
　End If
　
　While .Execute(FindText:=mWhat, _
　　Wrap:=wdFindContinue, MatchWildcards:=True) = True
　　Selection.Range.CharacterWidth = wdWidthFullWidth
　　'ここで、文字を全角に変換している
　Wend
End With
Exit Sub
Errmsg:
MsgBox "エラー!: " & Err.Description, vbExclamation
End Sub

Private Sub Zenkaku2Hankaku(ch1 As String, Optional ch2 As String, Optional blnShp As Boolean)
'半角へ
Dim myMsg As String
Dim mWhat As String
If blnShp = False Then
　 Selection.HomeKey Unit:=wdStory '文書の先頭に
End If
'ch1 = "０"　'ch2 = "ｚ"
On Error GoTo Errmsg:
With Selection.Find
　　.ClearFormatting
　　.Text = ""
　　.Replacement.Text = ""
　　.MatchFuzzy = False
　　'設定をクリア
If ch2 <> "" Then
　 mWhat = "[" & ch1 & "-" & ch2 & "]{1,}"
Else
　　mWhat = ch1
End If
While .Execute(FindText:=mWhat, _
　　Wrap:=wdFindContinue, MatchWildcards:=True) = True
　　Selection.Range.CharacterWidth = wdWidthHalfWidth
　　'ここで、文字を半角に変換。
Wend
End With
　　Exit Sub
Errmsg:
　 MsgBox "エラー!: " & Err.Description, vbExclamation
End Sub

Private Function regExpReplace(strVal As String, myPat As String, Optional ZHflg As Boolean)
'正規表現置換　パターン
　Dim Matches As Object
　Dim Match As Object
　Dim buf As String
　With CreateObject("VBScript.RegExp")
　　.Pattern = myPat
　　.Global = True
　　.IgnoreCase = False
　　Set Matches = .Execute(strVal)
　　If Not Matches Is Nothing Then
　　　buf = strVal
　　　For Each Match In Matches
　　　　If ZHflg Then
　　　　　'Ture = 半角
　　　　　buf = Replace(buf, Match.Value, StrConv(Match.Value, vbNarrow))
　　　　Else
　　　　　'False =全角
　　　　　buf = Replace(buf, Match.Value, StrConv(Match.Value, vbWide))
　　　　End If
　　　Next
　　regExpReplace = buf
　　Else
　　regExpReplace = strVal
　　End If
　End With
End Function

この回答への補足

こんにちは。makuro786です。
Wendy02さん。ありがとうございます。
提示されたテキストボックスと、ヘッダー・フッター分マクロのみ新しい文書に入れて、実行させてみました。前におきた様な問題もなくうまく変換されました。
あと「最後に、本文用のものを、このレスの後に続けます。」はどのようにすればよいのでしょうか？「#4 のテキストボックス用にコードを貼り付けてください。」が良くわかりません。ちなみに「ANo.4」のコードを今回のコードをそのままあとにつづけても、本文の英数・半角は変換されませんでした。
本当にお手数をおかけしてすみませんがよろしくお願いします。

補足日時：2006/09/25 14:29

No.6 回答者： Wendy02 回答日時： 2006/09/24 09:38

こんにちは。

動作試験をしていただくだけなので、ただ、単にに、ひとつのマクロを動かすという意味だったのですが……。元のマクロは全部で、５つのプロシージャで構成されていますが、その内、以下は、二つのプロシージャで構成されています。

Sub Zen2Han2()
'全角・半角の変更
　Hankaku2Zenkaku Chr(161), Chr(223) '。-゜
　Zenkaku2Hankaku ChrW(&HFF10), ChrW(&HFF5A)　'０ - ｚ
　Zenkaku2Hankaku ChrW(&HFF0C), ChrW(&HFF0E) '，- ．
　Selection.HomeKey Unit:=wdStory '文書の先頭に
End Sub

この場合は、


Sub Hankaku2Zenkaku()
Sub Zenkaku2Hankaku()

のサブルーチン・プロシージャ
が同時に必要です。

この回答への補足

こんばんは。makuro786です。

「単に一つのマクロを動かす」には二つの「サブルーチン・プロシージャが同時に必要」ということは、判りましたが、具体的にどのように、マクロを組めばよいのかわかりません。
重要なテストと思いますので、そのまま貼り付けですむようにしてもらえませんか？
お手数をかけます。

補足日時：2006/09/24 21:44

No.5 回答者： Wendy02 回答日時： 2006/09/23 23:31

こんばんは。

今回のマクロは、単独に、ツールのテキストボックスのみで、それだけをテストしてほしかったのです。
一応、これは成功している、と了解してよいのですね。

私が少しずつ提供していくものにスタイルを変えます。ご期待に反して申し訳ないとは思いますが、都合４種類のオブジェクトに対するマクロを、すべて、統一して一気に行うのは、元のデータをなしに行うのは、やはり無理がありました。

それで、一つずつ、確認しながら、積み上げ式で、解決という形に変更させていただきたいと思っております。

それから、Wordの普通のドキュメントの部分は、以下の4行のコードで変わるはずです。

以下がダメということになると、理由が分からないのです。こちらでは、以下のマクロは問題ないです。実際には、Wordでは、半角カタカナ以外は、分かりにくいのですが、以下が実行されていないのでしたら、私は限界です。

Sub Zen2Han2()
'全角・半角の変更
　Hankaku2Zenkaku Chr(161), Chr(223) '。-゜
　Zenkaku2Hankaku ChrW(&HFF10), ChrW(&HFF5A)　'０ - ｚ
　Zenkaku2Hankaku ChrW(&HFF0C), ChrW(&HFF0E) '，- ．
　Selection.HomeKey Unit:=wdStory '文書の先頭に
End Sub

一応、次は、オートシェイプの予定をして、こちらでは、問題も解決しています。

最終的に出来上がったら、統一呼び出しメイン・プロシージャにしようと考えております。

この回答への補足

今晩は。makuro786です。
お手数をかけます。

新しいWord文書開き、Alt+F11、「挿入」、「標準モジュール」クリックで開いたコードの画面に上記のマクロをそのまま貼り付け、適当な英数、カタカナを文書画面に入力し、マクロを実行しましたが、「subまたはfunctionが定義されていません」という表示がいきなり出てしまいます（「Sub Zen2Han2()」に黄色のマーク）
基本的なやり方がおかしいのでしょうか。
前回のマクロもこのようにして「単独で実行」させてみましたがこれと同じエラーがでます。

補足日時：2006/09/24 00:53

No.4 回答者： Wendy02 回答日時： 2006/09/23 19:31

こんばんは。

Wendy02です。
お手間を掛けてすみません。こちらは、あまりWordのマクロになれておりませんので、手間度っています。

一応、直せる範囲内だとは思いますが、

「オブジェクト関数が設定されていません」というエラー表示。

>If ctrl.OLEFormat.ClassType = "Forms.TextBox.1" Thenに黄色のマーク

ということは、テキストボックスと、オートシェイプ以外にも、他にも別のオブジェクトがあるということですね。私は、ここらは詳しくないのですが、回避する方法が、どうも確信を持って出来ませんので、この部分のみ、単独で通るか試してみていただけますか？

Sub CheckinToolBoxesR()
Dim ctrl As InlineShape
Dim buf As String
'テキストボックス(コントロールツール)
　For Each ctrl In ActiveDocument.InlineShapes
　 If ctrl.Type = wdInlineShapeOLEControlObject Then
　 If ctrl.OLEFormat.ClassType = "Forms.TextBox.1" Then
　　 If Len(ctrl.Range.Text) > 0 Then
　　 buf = ctrl.OLEFormat.Object.Text
　　 buf = regExpReplace(buf, "[" & ChrW(&HFF66) & "-" & ChrW(&HFF9F) & "]+", False)
　　 buf = regExpReplace(buf, "[" & ChrW(&HFF0C) & "-" & ChrW(&HFF0E) & "]+", True)
　　 buf = regExpReplace(buf, "[" & ChrW(&HFF10) & "-" & ChrW(&HFF5A) & ChrW(&H2015) & ChrW(&H2010) & "]+", True) '全角に
　　 ctrl.OLEFormat.Object.Text = buf
　　 End If
　 End If
　 End If
　Next ctrl
　End Sub

　残りのものに関して、オートシェイプに関しては、CheckinShapes()　は、全面的に取り消し、既存のものを利用することで、おそらくは直ります。オートシェイプは、Excelの感覚でいたので、間違えました。ヘッダ／フッターに関しては、まだ見ていません。基本的には、直るはずですが、分かりません。

この回答への補足

こんばんは。makuro786です。
こちらこそ、お手間をおかけして恐縮です。

先ほど試したWordマクロの指定箇所のみ入れ替えて、「Sub CheckinToolBoxesR」マクロのみ実行してみましたが、エラーは出ませんでした。なお、Word画面上の英数・カタカナは何の変化もありません。さらに、最初のマクロから実行すると、ツールテキストボックス内の英数・カタカナが変換され、次に今回のマクロの実行（変化なし？）、次のマクロでエラー表示がでます。

お手数をかけますがよろしくお願いします。

補足日時：2006/09/23 21:46

No.3 回答者： Wendy02 回答日時： 2006/09/22 23:01

こんばんは。

Wendy02です。

さすがに、これだけのものになると、かなり自信が揺らいでしまいます。
慣れていないものですし、４つのマクロをひとつにまとめ合わせたものですから、間違いはないと思いつつも、掲示には、気後れしてしまいます。なお、今回の開発は、Word 2003 で行っておりますが、下位バージョンでも問題ないはずです。

'--------------------------------------------------------------------
'<標準モジュール>
Sub ChrBytesArranging()
　 '全角半角変換マクロ
　 Hankaku2Zenkaku Chr(161), Chr(223) '。-゜
　 Zenkaku2Hankaku ChrW(&HFF10), ChrW(&HFF5A)　'０ - ｚ
　 Zenkaku2Hankaku ChrW(&HFF0C), ChrW(&HFF0E) '，- ．
　 'Zenkaku2Hankaku ChrW(&H2015)　'― '不要
　 'Zenkaku2Hankaku ChrW(&H2010) '‐　'不要
　
　 CheckinShapes 'オートシェイプ
　 CheckinToolBoxes　'コントロール
　 Header_FooterReplace　'ヘッダー・フッター
　 Selection.HomeKey Unit:=wdStory '文書の先頭に
　 Beep
End Sub

Private Sub Hankaku2Zenkaku(ch1 As String, Optional ch2 As String)
　'全角へ
　Dim myMsg As String
　Dim mWhat As String
　Selection.HomeKey Unit:=wdStory '文書の先頭に
　'ch1 = Chr(161) '半角の「。」,　'ch2 = Chr(223) '半角の「゜」
　On Error GoTo Errmsg:
　With Selection.Find
　　.ClearFormatting
　　.Text = ""
　　.Replacement.Text = ""
　　.MatchFuzzy = False
　　'設定をクリア
　If ch2 <> "" Then
　　　mWhat = "[" & ch1 & "-" & ch2 & "]{1,}"
　　Else
　　　mWhat = ch1
　End If
　
　While .Execute(FindText:=mWhat, _
　　Wrap:=wdFindContinue, MatchWildcards:=True) = True
　　Selection.Range.CharacterWidth = wdWidthFullWidth
　　'ここで、文字を全角に変換している
　Wend
End With
Exit Sub
Errmsg:
MsgBox "エラー!: " & Err.Description, vbExclamation
End Sub

Private Sub Zenkaku2Hankaku(ch1 As String, Optional ch2 As String)
'半角へ
Dim myMsg As String
Dim mWhat As String
Selection.HomeKey Unit:=wdStory '文書の先頭に
'ch1 = "０"　'ch2 = "ｚ"
On Error GoTo Errmsg:
With Selection.Find
　　.ClearFormatting
　　.Text = ""
　　.Replacement.Text = ""
　　.MatchFuzzy = False
　　'設定をクリア
If ch2 <> "" Then
　 mWhat = "[" & ch1 & "-" & ch2 & "]{1,}"
Else
　　mWhat = ch1
End If
While .Execute(FindText:=mWhat, _
　　Wrap:=wdFindContinue, MatchWildcards:=True) = True
　　Selection.Range.CharacterWidth = wdWidthHalfWidth
　　'ここで、文字を半角に変換。
Wend
End With
　　Exit Sub
Errmsg:
　 MsgBox "エラー!: " & Err.Description, vbExclamation
End Sub
Sub CheckinToolBoxes()
Dim ctrl As InlineShape
Dim buf As String
'テキストボックス(コントロールツール)
'Autosize にしてなければ、サイズは変更されませんので、文字が隠れることがあります。
　For Each ctrl In ActiveDocument.InlineShapes
　 If ctrl.OLEFormat.ClassType = "Forms.TextBox.1" Then
　　 If Len(ctrl.Range.Text) > 0 Then
　　 buf = ctrl.OLEFormat.Object.Text
　　 buf = regExpReplace(buf, "[" & ChrW(&HFF66) & "-" & ChrW(&HFF9F) & "]+", False)
　　 buf = regExpReplace(buf, "[" & ChrW(&HFF0C) & "-" & ChrW(&HFF0E) & "]+", True)
　　 buf = regExpReplace(buf, "[" & ChrW(&HFF10) & "-" & ChrW(&HFF5A) & ChrW(&H2015) & ChrW(&H2010) & "]+", True) '全角に
　　 ctrl.OLEFormat.Object.Text = Replace(buf, vbCr, "")
　　 End If
　 End If
　Next ctrl
　End Sub

Sub CheckinShapes()
'テキストボックス(オートシェイプ)
Dim shp As Shape
Dim buf As String
　For Each shp In ActiveDocument.Shapes
　 If shp.Type = msoTextBox Then
　　 buf = shp.TextFrame.TextRange.Text
　　 shp.TextFrame.TextRange.Text = Empty
　　 buf = regExpReplace(buf, "[" & ChrW(&HFF66) & "-" & ChrW(&HFF9F) & "]+", False)
　　 buf = regExpReplace(buf, "[" & ChrW(&HFF0C) & "-" & ChrW(&HFF0E) & "]+", True)
　　 buf = regExpReplace(buf, "[" & ChrW(&HFF10) & "-" & ChrW(&HFF5A) & ChrW(&H2015) & ChrW(&H2010) & "]+", True) '全角に
　　 shp.TextFrame.TextRange.Text = buf
　　 With shp.TextFrame.TextRange
　　　 .MoveEnd Unit:=wdWord, Count:=1
　　　 .Collapse Direction:=wdCollapseEnd
　　　 .Delete Unit:=wdCharacter, Count:=1
　　 End With
　 End If
　Next shp
　End Sub
Sub Header_FooterReplace()
'ヘッダー・フッター処理
Dim buf As String
　With ActiveDocument.Sections(1)
　 buf = .Headers(wdHeaderFooterPrimary).Range.Text
　 buf = regExpReplace(buf, "[" & ChrW(&HFF66) & "-" & ChrW(&HFF9F) & "]+", False)
　 buf = regExpReplace(buf, "[" & ChrW(&HFF0C) & "-" & ChrW(&HFF0E) & "]+", True)
　 buf = regExpReplace(buf, "[" & ChrW(&HFF10) & "-" & ChrW(&HFF5A) & ChrW(&H2015) & ChrW(&H2010) & "]+", True) '全角に
　 buf = Replace(buf, vbCr, "")
　　.Headers(wdHeaderFooterPrimary).Range.Text = buf
　 buf = ""
　 buf = .Footers(wdHeaderFooterPrimary).Range.Text
　 buf = regExpReplace(buf, "[" & ChrW(&HFF66) & "-" & ChrW(&HFF9F) & "]+", False)
　 buf = regExpReplace(buf, "[" & ChrW(&HFF0C) & "-" & ChrW(&HFF0E) & "]+", True)
　 buf = regExpReplace(buf, "[" & ChrW(&HFF10) & "-" & ChrW(&HFF5A) & ChrW(&H2015) & ChrW(&H2010) & "]+", True) '全角に
　 buf = Replace(buf, vbCr, "")
　 .Footers(wdHeaderFooterPrimary).Range.Text = buf
End With
　End Sub

Private Function regExpReplace(strVal As String, myPat As String, Optional ZHflg As Boolean)
'正規表現置換　パターン
　Dim Matches As Object
　Dim Match As Object
　Dim buf As String
　With CreateObject("VBScript.RegExp")
　　.Pattern = myPat
　　.Global = True
　　.IgnoreCase = False
　　Set Matches = .Execute(strVal)
　　If Not Matches Is Nothing Then
　　　buf = strVal
　　　For Each Match In Matches
　　　　If ZHflg Then
　　　　　'Ture = 半角
　　　　　buf = Replace(buf, Match.Value, StrConv(Match.Value, vbNarrow))
　　　　Else
　　　　　'False =全角
　　　　　buf = Replace(buf, Match.Value, StrConv(Match.Value, vbWide))
　　　　End If
　　　Next
　　regExpReplace = buf
　　Else
　　regExpReplace = strVal
　　End If
　End With
End Function

この回答への補足

こんにちは。makuro786です。

Wendy02さんには大変、お手数をかけてしまい恐縮しています。
早速、試してみました。４つのマクロをそれぞれ順番に実行させましたが、下に書いたように、途中でエラー表示がでて、うまく作動しません。
――――――――――――――――――――――――――――――――
以下、具体的に現象を書きます。
1.「CheckinShapes」の実行
ツールテキストボックス内の英数が半角に、カタカナが全角に変換される。ただし、最上行のインデントが解除され、一番左に寄せられてしまう。２行目以降は問題なし。
2.「CheckinToolBoxes」の実行
「オブジェクト関数が設定されていません」というエラー表示。
「デバック」でマクロを見ると、
If ctrl.OLEFormat.ClassType = "Forms.TextBox.1" Thenに黄色のマーク
3.「ChrBytesArranging」の実行
「CheckinToolBoxes」と同様のエラー表示
If ctrl.OLEFormat.ClassType = "Forms.TextBox.1" Thenに黄色のマーク
エラー表示が出る前に、メイン文書の英数（プラス一部記号）とカタカナは正常に変換される
4.「Header_FooterReplace」の実行
変換は実行されたが、ヘッダー、フッター内にある２行の表が削除され、すべて１行の文章になってしまう。また自動設定のページ番号／ページ数、日付などもテキストに変換されてしまう。
――――――――――――――――――――――――――――――――
もし修正していただけるようでしたら、ヘッダー／フッターのマクロは問題が大きそうな上、必要性が薄いので削除してもらい、上記不具合を改善していただけたらと思います。また、マクロを１回の実行ですむようにできたら使い勝手がよくなり大変助かるのですが。

以上よろしくお願いいたします。

補足日時：2006/09/23 11:18

No.2 回答者： Wendy02 回答日時： 2006/09/21 19:09

こんばんは。

Wendy02です。

出来上がりまして、今のところ問題は発生していませんが、前回のものを加工した関係で、そのままでは、やはりコードが長すぎます。しばらく、バグチェックと、メインテナンスの必要があります。本日は、掲示しても、バグがあったりして、無駄になる可能性がありますから、今日は、掲示できません。数日、お待ちください。

この回答へのお礼

こんばんは。makuro786です。

こんなに早く対応して頂いて、感激です。
ありがとうございます。
掲示される日を首を長くしてお待ちしています。
まずはお礼まで。

お礼日時：2006/09/21 21:52

No.1 回答者： Wendy02 回答日時： 2006/09/21 00:47

こんばんは。

そのマクロを書いた一人のWendy02です。

>「記録」機能の限界なのか「エラー」
それは、文字コードについて、Unicode ということが分かっていないと、エラーが出てしまいます。
半角カタカナは、

掲示板では書けないから、このような書き方になっていますが、
ch1 = Chr(161) '半角の「。」
ch2 = Chr(223) '半角の「゜」

直接、「-」で繋いで、置換の検索値に書き込んでしまってかまわないはずです。

>テキストボックス内、ヘッダー/フッター内は変換されないようでこまりはてています。

テキストボックスは、コントロールツールですか？フォームですか？それとも、オートシェイプのテキストボックスですか？

ここら辺は、ひじょうに、Wordはややこしいです。

この回答への補足

早速のご返事をありがとうございます。
マクロの作者から、返事を頂けるとは思ってもいませんでしたのでびっくりしています。
以下コメントについて回答します。

>文字コードについて、Unicode ということが分かっていないと、エラーが出てしまいます。
確かにまったくわかっていません。すこしづつ勉強しようと思っています。

>半角カタカナは、
掲示板では書けないから、このような書き方になっていますが、
ch1 = Chr(161) '半角の「。」
ch2 = Chr(223) '半角の「゜」
直接、「-」で繋いで、置換の検索値に書き込んでしまってかまわないはずです
わかりました。試してみます。

>テキストボックスは、コントロールツールですか？フォームですか？それとも、オートシェイプのテキストボックスですか？
ツールから作成するテキストボックスと、オートシェイブに「テキストの追加」で文字を挿入する場合の二つです。フォームは使用していません。

以上、よろしくお願いします。

補足日時：2006/09/21 11:26