| |
不具合の件について
これは、不覚でした！ 申し訳ありません。
ヘルプで、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
|
|
H. C. Shinopy
- 04/12/25(土) 0:17 -
