《Word2000》自動で振った段落番号を、一括で手打ちの番号に入力し直すには

質問

1.　りんご
　　（本文）

2.　みかん
　　（本文）

3.　バナナ
　　（本文）

このような構成の文書があります。
それぞれの章タイトル（果物の名前）は、現在段落番号で自動で振られているのですが、これを手打ちでテキスト入力した状態にしたいです。

ひとつひとつ目で見ていくのが確実なのでしょうが、他人が作ったファイルでしかもページ数がとても多いので、見落としが怖く、できれば機械的に行いたいのです。

コピーして「テキストでペースト」する方法は存じております。
ただこちらの方法にしても、見落としがあると数字が変わってしまいますので、最上の策とは言えないと思います。

せめて「自動で段落番号を振った行を検索」する方法があればいいのですが。

ご回答、お待ちしております。

回答No.2

misatoanna · ベストアンサー

自動記録の手も借りて修正作成しましたので、不要な行が入っていると思いますが.....。
見出しレベルが二段階までという前提です。
前回同様、最後にブックマーク E を作成して実行してください。

Sub ChgStyle()
　Dim LstPR1, LstPR2, ListST, STT
　If ActiveDocument.ListParagraphs.Count = 0 Then Exit Sub
　With ActiveDocument.Bookmarks
　　If Not .Exists("E") Then Exit Sub
　End With
　Selection.HomeKey Unit:=wdStory
　Do While Selection.Range.ListFormat.ListValue = 0
　　Selection.MoveDown Unit:=wdLine, Count:=1
　　Selection.HomeKey Unit:=wdLine
　Loop
　STT = ActiveDocument.Range(0, Selection.Start).ComputeStatistics(wdStatisticLines)
　LstPR1 = 0
　Do Until Selection.Range.Bookmarks.Exists("E")
　　Selection.MoveRight Unit:=wdCharacter, Count:=1
　　LstPR2 = ActiveDocument.Range(0, Selection.Start).ListParagraphs.Count
　　ListST = Selection.Range.ListFormat.ListString
　　Selection.HomeKey Unit:=wdLine
　　If LstPR2 <> LstPR1 Then
　　　Selection.TypeText Text:=ListST
　　　Selection.HomeKey Unit:=wdLine
　　End If
　　LstPR1 = LstPR2
　　Selection.MoveDown Unit:=wdLine, Count:=1
　Loop
　'
　Selection.GoTo What:=wdGoToLine, Count:=4
　ActiveDocument.Range(Start:=Selection.End, End:=ActiveDocument.Bookmarks("E").End).Select
　With ListGalleries(wdOutlineNumberGallery).ListTemplates(7).ListLevels(1)
　　.NumberFormat = "%1"
　　.TrailingCharacter = wdTrailingNone
　　.NumberStyle = wdListNumberStyleNone
　　.NumberPosition = MillimetersToPoints(0)
　　.TextPosition = MillimetersToPoints(7.5)
　　.TabPosition = wdUndefined
　End With
　With ListGalleries(wdOutlineNumberGallery).ListTemplates(7).ListLevels(2)
　　.NumberFormat = "%2"
　　.TrailingCharacter = wdTrailingNone
　　.NumberStyle = wdListNumberStyleNone
　　.NumberPosition = MillimetersToPoints(7.5)
　　.TextPosition = MillimetersToPoints(15)
　　.TabPosition = wdUndefined
　End With
　ListGalleries(wdOutlineNumberGallery).ListTemplates(7).Name = ""
　Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
　　wdOutlineNumberGallery).ListTemplates(7), ContinuePreviousList:=True, _
　　ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:=wdWord9ListBehavior
End Sub

回答No.4

misatoanna

私の環境も 2000 です。
前回言い訳させていただいたように、真ん中ほどの Loop 以下は自動記録の手を借りた
部分なのですが、そちらでなぜ止まるのかわかりません。
ご質問内に書かれていた例文からは、[書式]-[箇条書きと段落番号] のアウトラインを
設定されているはずなのですし....... ？

とりあえず、
　.NumberFormat = "%1"
の行を削除してみてください。（８行下にもありますので、これも削除）
私のテスト実行では、削除しても同じように動きました。
また、
　.TabPosition = wdUndefined
も２つとも削除。
ついでに、一番下の方にある
　ListGalleries(wdOutlineNumberGallery).ListTemplates(7).Name = ""
も削除してください。
自動記録で付けられた不要行のようです。

これでも止まってしまう場合は、真ん中の Loop より下を　Exit Sub の前まで削除して
実行し、その後アウトラインスタイルの変更を手作業で行なってください

お礼

本当にありがとうございます！
まだ動きが微妙なのですが、VBAの勉強も兼ねて、色々いじってみたいと思います。

回答No.3

misatoanna

＃２の修正です。

プログラムの中央ほどにある(Loop のすぐ下)
　Selection.GoTo What:=wdGoToLine, Count:=4
を
　Selection.GoTo What:=wdGoToLine, Count:=STT
に変更してください。
テスト時の状態のまま載せてしまいました。　　/(-_-;

お礼

すみません、再びこんなに長いVBA書いていただきまして…

テストしてみましたところ、「実行時エラー5974　箇条書きの書式のプレースホルダとして、番号を指定することはできません」と出ます。
デバッグは、Loopの数行下の

.NumberFormat = "%1"

の位置で止まっております。ハテ？
エクセルのバージョンの違いか何かでしょうか？（当方2000です）

回答No.1

misatoanna

自信はないのですが、とりあえず、文章のレイアウトを勝手に仮定して、マクロを作って
みました。
　１．項目１
　(Tab)本文１行目
　(Tab)本文２行目
　２．項目２
　(Tab)本文１行目
のようになります。

[Alt]+[F11] で開く画面の左側のツリーにある Project(開いている文書名) を選択して
[挿入]-[標準モジュール] で更に開く画面に下記をコピーし、通常画面に戻ってください。

Sub Test()
　　Dim PG, LV, LVSeq, NumberSize
　　If ActiveDocument.ListParagraphs.Count = 0 Then Exit Sub
　　With ActiveDocument.Bookmarks
　　　　If Not .Exists("E") Then Exit Sub
　　End With
　　PG = ActiveDocument.ComputeStatistics(Statistic:=wdStatisticLines)
　　Selection.HomeKey Unit:=wdStory
　　LVSeq = 0
　　Do While Selection.Range.ListFormat.ListValue = 0
　　　　Selection.MoveDown Unit:=wdLine, Count:=1
　　　　Selection.HomeKey Unit:=wdLine
　　Loop
　　Do Until Selection.Range.Bookmarks.Exists("E")
　　　　Selection.HomeKey Unit:=wdLine
　　　　LV = Selection.Range.ListFormat.ListValue
　　　　If LV = 1 Then
　　　　　　LVSeq = LVSeq + 1
　　　　　　If LVSeq > 9 Then NumberSize = LVSeq Else NumberSize = StrConv(LVSeq, vbWide)
　　　　　　Selection.TypeText Text:=NumberSize & "．"
　　　　　　Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
　　　　Else
　　　　　　Selection.TypeText Text:=vbTab
　　　　End If
　　　　Selection.MoveDown Unit:=wdLine, Count:=1
　　Loop
　　Selection.HomeKey Unit:=wdStory
End Sub

文章の最後の段落番号項目の「本文」の最後の行の次行先頭に E という名前のブックマークを
挿入してから、[ツール]-[マクロ]-[マクロ] の Test を選択して実行してみてください。

文書ファイルのコピーで行なってくださいね。
結果が求められているものと異なっていたら、無視してください。　　　^_^;

お礼

どうもありがとうございます！
これなら確かに置き換わります。

ただ非常に恐縮なのですが、
・本文先頭のタブを抜く
・違った形式の段落番号があっても、最初のスタイルが適応されてしまう。単純に、コピペで置き換えたい

以上の処理は可能でしょうか？

※現在このような文書だった場合、

1.見出し1（段落番号）
　　本文
2.見出し2（段落番号）
　　本文
　A.小見出しA（段落番号）
　　本文
　B.小見出しB（段落番号）
　　本文
3.見出し3（段落番号）

↓このように置き換えられてしまいます。

1.見出し1
　(Tab)本文
2.見出し2
　(Tab)本文
　3.小見出しA
　(Tab)本文
　4.小見出しB
　(Tab)本文
5.見出し3

↓単純にこのようにするのは、難しいでしょうか。
1.見出し1
　　本文
2.見出し2
　　本文
　A.小見出しA
　　本文
　B.小見出しB
　　本文
3.見出し3

もし難しい場合は、どうかスルーして下さい。
ここまでやって頂いて、本当に感謝しております。