Word VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


209 / 308 ツリー ←次へ | 前へ→

【317】見出しの設定や複数行の削除の方法 tootsie 05/8/10(水) 13:12 質問[未読]
【318】Re:見出しの設定や複数行の削除の方法 H. C. Shinopy 05/8/12(金) 22:23 回答[未読]
【321】Re:見出しの設定や複数行の削除の方法 tootsie 05/8/16(火) 12:20 お礼[未読]
【322】Re:見出しの設定や複数行の削除の方法 tootsie 05/8/16(火) 13:09 発言[未読]

【317】見出しの設定や複数行の削除の方法
質問  tootsie  - 05/8/10(水) 13:12 -

引用なし
パスワード
   暑い日が続きます。お疲れさまです。

またまた虫のよい質問で大変恐縮ですが、ワード上で下記のようなマクロを作りたいときは、どのようにしたらよいでしょうか。loop 機能を使わないでもできる方法かどうか知りたいです。

よろしくお願いします。


1.[Box・・・で始まる行を含め、そこから5行分をすべて削除する。
2.行の先頭が◎で始まる行に「見出し1」を設定する。
3.【編・・・で始まる行を削除する。
4.EEEEで始まる行を含め、そこから3行分をすべて削除する。

(注)1〜3いずれも、文書中に該当する箇所が複数ある。「・・・」にはさまざまな文字が入っている。[、◎、【の3種類の記号は削除の際、いずれもキーになる記号かと思います。

【318】Re:見出しの設定や複数行の削除の方法
回答  H. C. Shinopy  - 05/8/12(金) 22:23 -

引用なし
パスワード
   まず、御質問の件ですが、
ワイルドカードを使って文字列を検索するのが、最もやり易いと思います。
「loop 機能を使わないでも…」についてですが、
検索する文字列が複数箇所ある場合は、使わないわけにはいかないでしょう。

『1.[Box・・・で始まる行を含め、そこから5行分をすべて削除する。』についてだけですが、
一例として下記のマクロを考えました。

他の条件は、このマクロの後に処理を継ぎ足すか、
繰り返し処理で検索文字列を差し替えるとかでできると思います。

検索した文字列が行の先頭か?その文字列の後に文字があるか?を
マクロで実現するのが難しいですね。
文書の内容によっては、マクロがもっと単純あるいは複雑になることもあると思いますが。
(例えば、実際の文書で『[Box・・・』が必ず行の先頭にあって
「・・・」が必ずあるなら、もっと単純で済みます。)

そのようなわけで「myString」の値(ワイルドカードの検索文字列)は、
文書の内容(文章をどう入力したか)を私なりに想像した一例ですので、
tootsieさんの文書ファイルに完全に適合しているかどうかは、
断言できませんので御容赦ください。

下のマクロは既存のものからコピーしてきたので、
検索範囲の判断という余分な処理もしています。
(不要な部分を削るのは簡単ですので、そのままにしてます。これも御容赦を。)

Sub myFindText()
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 Rem 検索置換処理
 Rem カーソル位置から文書の末尾までの範囲を検索する。
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 Dim myString As String
 Dim i As Integer
 Dim myRange As Range
 Dim myChrs As Characters
 Dim myChrsFound As Characters
 Dim myText As String
 Dim myLen As Long
 Dim myPos As Long
 Dim myCursor As Long
 '
 myString = "[[]{1,1}Box[!^8-^32]{1,}[^11^13]{1,}"
 '
 Rem カーソル位置の行の先頭に移動する。
 Selection.HomeKey Unit:=wdLine, Extend:=wdMove
 '
 Rem カーソル位置から文書の末尾までの範囲を選択する。
 Selection.EndKey Unit:=wdStory, Extend:=wdExtend
 '
 Set myRange = Selection.Range
 Set myChrs = myRange.Characters
 Selection.Collapse wdCollapseStart
 '
 With Selection.Find
  .ClearFormatting
  .Text = myString
  .Forward = True
  .Wrap = wdFindStop
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  .MatchWildcards = True
  Do
   .Execute
   If Not .Found Then Exit Do
   '
   Set myChrsFound = Selection.Range.Characters
   '
   Rem 検索の範囲外の場合、処理しない。
   If myChrsFound.First.Start < myChrs.First.Start Then Exit Do
   If myChrsFound.Last.End > myChrs.Last.End Then Exit Do
   '
   Rem カーソルを行の先頭に戻す。
   Rem 検索した文字列が行の先頭かどうか判断する。
   myLen = Len(Selection.Range.Text)
   myPos = Selection.HomeKey(Unit:=wdLine, Extend:=wdMove)
   myPos = myPos + myLen
   '
   If myPos = 0 Then
    Rem 行の先頭だった場合
    Rem MsgBox "選択範囲は移動されませんでした。"
    Selection.MoveDown Unit:=wdLine, Count:=5, Extend:=wdExtend
    Selection.Range.Text = ""
   Else
    Rem 行の先頭でない場合、読み飛ばし。
    .Execute
    Selection.Collapse wdCollapseEnd
   End If
   '
   myCursor = myChrsFound.First.Start - myChrs.First.Start + 1
   i = Int(myCursor * 100 / myChrs.Count)
   Application.StatusBar = "myFindText" & ":処理中" & " " & Format(i, "##0") & "%"
  Loop
 End With
 '
 Rem カーソル位置を元に戻す。
 myRange.Select
 Selection.Collapse wdCollapseStart
 '
 Set myRange = Nothing
 Set myChrs = Nothing
 Set myChrsFound = Nothing
End Sub ' myFindText *----*----*  *----*----*  *----*----*  *----*----*

【321】Re:見出しの設定や複数行の削除の方法
お礼  tootsie  - 05/8/16(火) 12:20 -

引用なし
パスワード
   早速のご指導、ありがとうございます。
こちらで試してみます。

実は、「4. EEEE・・・」で、マクロの記録とloopを使って作ってみたのですが、うまくいかない場合があります。(EEEEが削除されないものが出てくる場合が、かなりあるのです)
どうしてそうなってしまうのか分からないのですが、いただいたマクロと比較しながら試行錯誤してみます。

また、お返事いたします。まずは取り急ぎお礼まで。

【322】Re:見出しの設定や複数行の削除の方法
発言  tootsie  - 05/8/16(火) 13:09 -

引用なし
パスワード
   いただいたマクロをそのまま使ってみましたが、うまくいかないので、もう一度「マクロの記録」と「loop」を使って、それを追加していく形で作り直してみました。
うまくいかなかった原因は、よけいな場所に「Selection.Find.Execute」が入っているためだと判明。解決しました。

問題は「見出し」の設定ですが、こちらは、別の質問として、もう一度改めてお伺いしたいと考えております。

よろしくお願い致します。

209 / 308 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
207139
(SS)C-BOARD v3.8 is Free