Word VBA質問箱 IV

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

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


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

【188】検索文字列のある文より前の文の削除 TAMA 04/12/22(水) 11:29 質問[未読]
【189】Re:検索文字列のある文より前の文の削除 H. C. Shinopy 04/12/24(金) 0:08 回答[未読]
【190】Re:検索文字列のある文より前の文の削除 TAMA 04/12/24(金) 16:21 質問[未読]
【191】Re:検索文字列のある文より前の文の削除 H. C. Shinopy 04/12/25(土) 0:17 回答[未読]
【192】Re:検索文字列のある文より前の文の削除 TAMA 04/12/25(土) 12:26 お礼[未読]

【188】検索文字列のある文より前の文の削除
質問  TAMA  - 04/12/22(水) 11:29 -

引用なし
パスワード
   「一 東京都」という文字列を検索して、
その文字列を含む最初のセンテンスを
先頭にするため、それより前のセンテンスを
全て削除したいのです。
該当の文書ファイルがたくさんあるので
あるフォルダ内の文書ファイルを自動的に
処理できればと思います。
フォルダ内には、検索文字列が無い
文書ファイルもあるという前提で
教えていただけるとありがたいです。
よろしくお願いします。

【189】Re:検索文字列のある文より前の文の削除
回答  H. C. Shinopy  - 04/12/24(金) 0:08 -

引用なし
パスワード
   以下、取り敢えず、返信したします。

過去の事例を引っ張り出しきて、
「一 東京都」という文字列を検索し、
その文字列より前を削る処理だけ追加しました。

下記のマクロは、
ファイルを警告なしに上書き保存しますので、
処理前に、必ずファイルをバックアップして下さい。

Wordを起動した直後の状態で実行して頂ければ幸いです。
尚、「一 東京都」という文字列がない場合は、
ファイルを閉じるだけの処理をするようにしています。

Sub myDocRewrite()
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 Rem 「一 東京」より文書の先頭を削除して、
 Rem 上書き保存する。
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 Dim myDlgPick As FileDialog
 Dim myFile As Variant
 Dim myWord As Word.Application
 Dim myCount As Long
 Dim c As Long
 '
 Rem 前処理
 If Documents.Count >= 2 Then
  MsgBox "文書を閉じて下さい。"
  Exit Sub
 End If
 If Documents.Count = 1 Then
  If ActiveDocument.Characters.Count > 1 Then
   MsgBox "文書を閉じて下さい。"
   Exit Sub
  Else
   If ActiveDocument.Words(1).Text <> vbCr Then
    MsgBox "文書を閉じて下さい。"
    Exit Sub
   Else
    Application.DisplayStatusBar = True
    ActiveDocument.Close
   End If
  End If
 End If
 '
 Rem ファイル群の指定
 Set myDlgPick = Application.FileDialog(msoFileDialogFilePicker)
 With myDlgPick
  .AllowMultiSelect = True
  .Filters.Add "Word文書", "*.doc", 1
  If .Show = 0 Then
   Rem [キャンセル]ボタン
   Set myDlgPick = Nothing
   Application.Documents.Add
   Exit Sub
  End If
 End With
 '
 Rem ファイルごとの処理
 Set myWord = GetObject(, "Word.Application")
 '
 c = 0
 Application.ScreenUpdating = False ' 画面更新をオフにする。
 '
 For Each myFile In myDlgPick.SelectedItems
  myWord.Documents.Open myFile ' ファイルを開く
  Selection.HomeKey Unit:=wdStory ' 文書の先頭にカーソル移動
  '
  Rem ステータスバーに件数表示
  c = c + 1
  Application.StatusBar = "処理中:" & c & "/" & myDlgPick.SelectedItems.Count & "件"
  '
  Rem 文字列「一 東京」を探す。
  myCount = Selection.MoveUntil(Cset:="一 東京", Count:=wdForward)
  myCount = myCount - 1
  '
  If myCount = -1 Then
   Rem 探した文字列なしの場合
   myWord.ActiveDocument.Close
  Else
   Selection.HomeKey Unit:=wdStory, Extend:=wdExtend ' 文書の先頭までの範囲を選択する。
   Selection.Range.Text = "" ' 選択範囲を削除
   Rem ファイルの保存
   With myWord
    .ActiveDocument.SaveAs FileName:=myFile ' 上書き保存
    .ActiveDocument.Close
   End With
  End If
 Next myFile
 '
 Application.ScreenUpdating = True ' 画面更新をオンにする。
 '
 Rem 後処理
 myWord.Documents.Add
 Set myDlgPick = Nothing
 Set myWord = Nothing
End Sub ' myDocRewrite *----*----*  *----*----*  *----*----*  *----*----*

【190】Re:検索文字列のある文より前の文の削除
質問  TAMA  - 04/12/24(金) 16:21 -

引用なし
パスワード
   H. C. Shinopy様
早速、ご回答ありがとうございます。

しかし、不具合が...。
「一 東京都」という続きの文字列ではなく、その中の文字のうち
一番早く出てくる文字を検索して、それ以前の文字を削除してしまいます。
例えば、「一 東京都」という文字列より前に、「東」という文字やスペースがあるとその文字やスペースの前までの文字を削除してしまうのです。

あと、行単位の削除というのは難しいのでしょうか。
ある続きの文字列を含む行までを削除する方法はないのでしょうか。

お願いばかりで申し訳ありませんが、よろしくお願いします。

【191】Re:検索文字列のある文より前の文の削除
回答  H. C. Shinopy  - 04/12/25(土) 0:17 -

引用なし
パスワード
   不具合の件について
これは、不覚でした! 申し訳ありません。
ヘルプで、MoveUntilの文法を確認しました。
ここは素直に考えるべきであったと、反省しております。
定番の「Selection.Find...」で文字列を検索することにします。
それからダイアログボックスを「msoFileDialogFilePicker」から
「msoFileDialogOpen」に変更しました。

Sub myDocRewrite()
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 Rem 「一 東京」より文書の先頭を削除して、
 Rem 上書き保存する。
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 Dim myDlgOpen As FileDialog
 Dim myFile As Variant
 Dim myWord As Word.Application
 Dim myCount As Long
 Dim c As Long
 '
 Rem 前処理
 If Documents.Count >= 2 Then
  MsgBox "文書を閉じて下さい。"
  Exit Sub
 End If
 If Documents.Count = 1 Then
  If ActiveDocument.Characters.Count > 1 Then
   MsgBox "文書を閉じて下さい。"
   Exit Sub
  Else
   If ActiveDocument.Words(1).Text <> vbCr Then
    MsgBox "文書を閉じて下さい。"
    Exit Sub
   Else
    Application.DisplayStatusBar = True
    ActiveDocument.Close
   End If
  End If
 End If
 '
 Rem ファイル群の指定
 Set myDlgOpen = Application.FileDialog(msoFileDialogOpen)
 With myDlgOpen
  .AllowMultiSelect = True
  .Filters.Add "Word文書", "*.doc", 1
  If .Show = 0 Then
   Rem [キャンセル]ボタン
   Set myDlgOpen = Nothing
   Application.Documents.Add
   Exit Sub
  End If
 End With
 '
 Rem ファイルごとの処理
 Set myWord = GetObject(, "Word.Application")
 '
 c = 0
 Application.ScreenUpdating = False ' 画面更新をオフにする。
 '
 For Each myFile In myDlgOpen.SelectedItems
  myWord.Documents.Open myFile ' ファイルを開く
  Selection.HomeKey Unit:=wdStory ' 文書の先頭にカーソル移動
  '
  Rem ステータスバーに件数表示
  c = c + 1
  Application.StatusBar = "処理中:" & c & "/" & myDlgOpen.SelectedItems.Count & "件"
  '
  Rem 文字列「一 東京」を一度だけ検索する。
  With Selection.Find
   .ClearFormatting
   .Text = "一 東京"
   .Forward = True
   .Wrap = wdFindStop
   .Execute
  End With
  '
  If Not Selection.Find.Found Then
   Rem 検索した文字列がない場合の処理。
   myWord.ActiveDocument.Close
  Else
   Rem 検索した文字列がある場合の処理。
   Rem カーソルを検索した文字列の前に移動する。
   Selection.Collapse wdCollapseStart
   Rem 文書の先頭までの範囲を選択する。
   myCount = Selection.HomeKey(wdStory, wdExtend)
   If myCount = 0 Then
    Rem 書き換え不要の文書だった場合の処理。
    myWord.ActiveDocument.Close
   Else
    Selection.Range.Text = "" ' 選択範囲を削除
    Rem ファイルの保存
    With myWord
     .ActiveDocument.SaveAs FileName:=myFile ' 上書き保存
     .ActiveDocument.Close
    End With
   End If
  End If
 Next myFile
 '
 Application.ScreenUpdating = True ' 画面更新をオンにする。
 '
 Rem 後処理
 myWord.Documents.Add
 Set myDlgOpen = Nothing
 Set myWord = Nothing
End Sub ' myDocRewrite *----*----*  *----*----*  *----*----*  *----*----*


「ある続きの文字列を含む行までを削除する方法はないのでしょうか」の件
文意が曖昧な感じですが、ここでは
『ある特定の文字列を含む文と、そこから文書の先頭までの文字を、
共に削除する』と解釈します。
ここで言う「文」とは、(私のWord VBA経験の範囲では)
文字列の最後に「。」あるいは改行記号があるもの
(英語の文章であれば、「. 」(ピリオド・スペース)が文字列の最後に付いているもの)という
ことになります。
その他の場合は、マクロを試しに実行することで調べる必要があります。

御質問の件は、下の通りとなります。
下の例ですと、検索した文字列のカーソル位置からではなく、
その文字列を含む文(「。」や改行のある所まで)から前を削除します。

Sub mySentencesDelete()
 Dim myCount As Long
 '
 Selection.HomeKey Unit:=wdStory ' 文書の先頭にカーソル移動
 '
 Rem 文字列「一 東京」を一度だけ検索する。
 With Selection.Find
  .ClearFormatting
  .Text = "一 東京"
  .Forward = True
  .Wrap = wdFindStop
  .Execute
 End With
 '
 If Not Selection.Find.Found Then
  Rem 検索した文字列がない場合の処理。
  Exit Sub
 Else
  Rem 検索した文字列がある場合の処理。
  Rem 検索した文字列を含む文の選択。
  Selection.Sentences(1).Select
  Rem カーソルを文の後に移動する。
  Selection.Collapse wdCollapseEnd
  Rem 文書の先頭までの範囲を選択する。
  myCount = Selection.HomeKey(wdStory, wdExtend)
  Selection.Range.Text = "" ' 選択範囲を削除
 End If
End Sub

【192】Re:検索文字列のある文より前の文の削除
お礼  TAMA  - 04/12/25(土) 12:26 -

引用なし
パスワード
   本当にありがとうございます。

すべてうまくいきました。

また、お世話になることがあるとおもいますが、
よろしくお願いします。

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