Wordで段組みをテキストで出力するマクロ

段組みを使ったWord文書を段組みの情報を残したままテキストで出力する方法です。
1段の場合は40文字、2段の場合は19文字で改行を挿入します。
段組みの段数は「段落.PageSetup.TextColumns.Count」で取得できます。
またセクション区切りの部分(文字コードが12)はそのまま出力すると表示がおかしくなるので判定して無視します。
関数「cut」は文字列に指定した文字数で改行を挿入します。

Sub 段組みをテキスト出力()
'段数に応じて改行を追加しテキストファイルに出力する。
Const mojisu1 = 40 '段数が1のとき
Const mojisu2 = 19 '段数が2のとき
Const myfilename = "d:\test.txt"
Dim danrakusu, dansu, mojisu, i
Dim danraku
Dim mytext
'各段落の文字列と段数を取得し、段数に応じて改行を追加する。
danrakusu = ActiveDocument.Paragraphs.Count
mytext = ""
For i = 1 To danrakusu
danraku = ActiveDocument.Paragraphs(i)
dansu = danraku.PageSetup.TextColumns.Count
If (Asc(danraku) <> 12) Then
If dansu = 1 Then
mojisu = mojisu1
Else
mojisu = mojisu2
End If
mytext = mytext & cut(danraku, mojisu)
End If
Next i
'文字列をテキストファイルに出力する。
With CreateObject("ADODB.Stream")
.Type = 2
.Charset = "utf-8"
.Open
.WriteText mytext, 1
.SaveToFile myfilename, 2
.Close
End With
End Sub
Function cut(str, num)
Dim i
For i = 1 To Len(str)
cut = cut & Mid(str, i, 1)
If i Mod num = 0 Then
cut = cut & Chr(13)
End If
Next i
End Function