Word VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム

36 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【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