| |
以下、取り敢えず、返信したします。
過去の事例を引っ張り出しきて、
「一 東京都」という文字列を検索し、
その文字列より前を削る処理だけ追加しました。
下記のマクロは、
ファイルを警告なしに上書き保存しますので、
処理前に、必ずファイルをバックアップして下さい。
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 *----*----* *----*----* *----*----* *----*----*
|
|
H. C. Shinopy
- 04/12/24(金) 0:08 -
