WORDのマクロについて質問です

質問

WORDのマクロで質問です。

WORDでテキストファイルを読み込み、整形する作業があるのですが、
テキストファイルの行数を判断して、その回数だけマクロを実行さ
せるようにするには、どうすればよいのでしょうか。

具体的には、

Sub 整形()
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=5
Selection.TypeText Text:=" "
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=8
End Sub

この作業を行数分だけ行うマクロを作成したいのですが、Webで調べて
みても、ピンと来るものが見つかりませんでした。

どうかお助けください。

回答No.4

Wendy02 · ベストアンサー

こんにちは。

#1,#3の回答者です。

>今、あるソフトで行おうと試みた結果だったのです。
Office があれば、十分ですね。

一応、文字の先頭が、000 のみに対応し、スペースを3個入れるように書き換えてみました。
"000" という条件が必要なければ、rngPara.Text Like "000*" を取り去り
　　　If Len(rngPara.Text) > 8 Then
にしてしまってください。

-------------------------------------------------------

Sub 整形2R()
Dim para As Paragraph
Dim rngPara As Range
　Selection.HomeKey Unit:=wdStory
　For Each para In ActiveDocument.Paragraphs
　　Set rngPara = para.Range
　　　If Len(rngPara.Text) > 8 And rngPara.Text Like "000*" Then
　　　　　rngPara.Collapse Direction:=wdCollapseStart
　　　　　Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
　　　　　Selection.Delete
　　　　　Selection.MoveRight Unit:=wdCharacter, Count:=5
　　　　　Selection.InsertAfter Text:=Space(3)
　　　End If
　　　Selection.Move Unit:=wdParagraph
　Next para
End Sub

#3の回答の場合は、Word専用となると、ちょっと面倒ですね。これが、Excelをお持ちでしたら、そちらのほうがバリエーションが多いので、#3の同じ目的のコードとしては簡単になります。当然、テキストファイルは、そのまま複数でも加工することが可能です。

なお、#3の場合は、

以下の部分を書き換えてくれれば、可能です。

　Do Until EOF(inFno)
　　　Line Input #inFno, tmp
　　　If Len(tmp) > 9 Then
　　　　　tmp = Mid$(tmp, 4)
　　　　　tmp = Mid$(tmp, 1, 5) & Space(3) & Mid$(tmp, 6)
　　　End If
　　　Print #outFno, tmp
　　　tmp = ""
Loop

お礼

おかげさまで助かりました。

一行、一行マクロ処理をしていたのですが、すべて１Keyで処理することが可能となりました。

本当にありがとうございます。

回答No.3

Wendy02

こんばんは。
#1 の回答者です。

#1 のマクロは、
×　If Len(rngPara.Text) > 5 Then
　　　　↓
　If Len(rngPara.Text) > 8 Then

に変更してください。

それと、繰り返しますが、Wordには、行の概念が明確ではありませんから、行はあくまでも、目で見たものに対するもので、そのまま、文字列を行ったり来たりしても、うまく行かないはずです。

なお、テキストファイル用のマクロを作ってみました。

'-------------------------------------------

'標準モジュール
'(Word用）

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
　　(lpofn As OPENFILENAME) As Long
Type OPENFILENAME
　　lStructSize As Long
　　hwndOwner As Long
　　hInstance As Long
　　lpstrFilter As String
　　lpstrCustomFilter As String
　　nMaxCustomFilter As Long
　　nFilterIndex As Long
　　lpstrFile As String
　　nMaxFile As Long
　　lpstrFileTitle As String
　　nMaxFileTitle As Long
　　lpstrInitialDir As String
　　lpstrTitle As String
　　flags As Long
　　nFileOffset As Integer
　　nFileExtension As Integer
　　lpstrdefext As String
　　lCustData As Long
　　lpfnHook As Long
　　lpTemplateName As String
End Type
Const OFN_PATHMUSTEXIST = &H800
Sub TextArrangement()
　Dim lpofn As OPENFILENAME
　Dim inFno As Integer
　Dim outFno As Integer
　Dim Fname As String
　Dim outFname As String
　Dim rc As Long
　Dim tmp As String
　With lpofn
　　.hwndOwner = 0
　　.flags = OFN_PATHMUSTEXIST
　　.lStructSize = Len(lpofn)
　　.lpstrFilter = "Text File(*.txt)" + Chr(0) + "*.txt"
　　.lpstrFile = String(256, Chr(0))
　　.nMaxFile = 256
　　.lpstrInitialDir = CurDir()
　　.nFilterIndex = 1
　End With

　rc = GetOpenFileName(lpofn)
　If rc = 0 Then Exit Sub
　Fname = lpofn.lpstrFile
　inFno = FreeFile()
　Open Fname For Input As #inFno

　outFno = FreeFile()
　outFname = "$tmp.txt"　　'Tempファイル
　Open outFname For Output As #outFno

　Do Until EOF(inFno)
　　　Line Input #inFno, tmp
　　　If Len(tmp) > 9 Then
　　　　　tmp = Mid$(tmp, 3)
　　　　　tmp = Mid$(tmp, 1, 5) & Space(1) & Mid$(tmp, 6)
　　　End If
　　　Print #outFno, tmp
　　　tmp = ""
　Loop
　 Close #inFno
　 Close #outFno
　 Application.Documents.Open FileName:="$tmp.txt", Format:=wdOpenFormatText
End Sub

回答No.2

okormazd

テキストファイルを読み込んで、これをいきなり実行すれば、たぶん、
最初の3文字を削除して、5,6文字目の間にスペースを入れて、1行下にずれて8文字戻る。
6文字目から8文字戻るから、1行目の最後から(段落記号も数えて)2文字目に戻るということか。
なにかの都合なのだろう。
行数分だけ実行するということだが、文字数が足りない行があれば、行数分だけ実行できないかもしれない。8文字戻れないかもしれない。このテキストファイルにはそういう恐れはないのですか。

さて、行数だが、次で取れるけど、実行しているうちに行数が変わってしまう恐れがあるが、その処理は適当に考えて・・・。

Sub 整形()

Set temp = Dialogs(wdDialogToolsWordCount)
temp.Execute
numlines = temp.Lines　　'文書の行数

'以下
'For　文などで回数分実行

Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=5
Selection.TypeText Text:=" "
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=8

End Sub

回答No.1

Wendy02

こんにちは。

質問する場合は、コードだけで、分かってもらえればよいのですが、出来る限り、マクロの前と希望の形を示してくださいね。こちらの誤解している可能性もないとは言えませんから。

例：

Abcあいうえおかきくけこ
　　　↓
あいうえお かきくけこ　←半角スペースが、「お」と「か」の間に入る

>Selection.MoveLeft Unit:=wdCharacter, Count:=8
なお、なぜ、左に8つなのか、この意味が良く分かりません。
-------------------------------------

もし、こういう形でよいのでしたら、こんなマクロになります。
また、Text ファイルの場合は、テキストの中で処理したほうが、速いかもしれません。Wordには、直接、行自体のコンセプトがはっきりしませんので、ちょっとややこしくなります。

Sub 整形2()
Dim para As Paragraph
Dim rngPara As Range
　Selection.HomeKey Unit:=wdStory
　For Each para In ActiveDocument.Paragraphs
　　Set rngPara = para.Range
　　　If Len(rngPara.Text) > 5 Then
　　　　　rngPara.Collapse Direction:=wdCollapseStart
　　　　　Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
　　　　　Selection.Delete
　　　　　Selection.MoveRight Unit:=wdCharacter, Count:=5
　　　　　Selection.InsertAfter Text:=" "
　　　End If
　　　Selection.Move Unit:=wdParagraph
　Next para
End Sub

補足

早速の回答ありがとうございます。
整形するテキストの元データ－は

00012345____1234567890123456.........(改行）
00012345____1234567890123456.........(改行）
　　　　　　　　　　　・
　　　　　　　　　　　・
　　　　　　　　　　　・
と続く形式で提供されます。

これを取引先のフォームに変換するために

12345_______1234567890123456.........（改行）

と言った具合に左の000を削除して右のスペースを3つ増やすという作業
をマクロで組みたかったのです。

会社のパソコンでしたので、シェアウェアなどの高機能テキストエディタ
をインストゥールすることができず、今、あるソフトで行おうと試みた結
果だったのです。

説明不足ですみませんでした。

左に8つ戻るのは、「マクロを記録」コマンドでキー操作のままマクロを
作ったために、１つ１つキーを追う形となってしまいました。