6年以上前、Wordに貼り付けたソースコードを番号付きのテーブルに変換するマクロを書きました。
改めて使ってみると、一部使用を変えた方が使いやすくなるのではないかと思い、マクロを書き直してみました。
下記コードで変換されるテーブルの書式は、モノクロ印刷を想定したものです。
文字色やサイズ、罫線の線種等、自分の好みに合わせて適当に変更してください。
Public Sub SourceCodeToTable()
'選択しているソースコードを表形式で出力
Dim tbl As Word.Table
Dim ur As Word.UndoRecord
Dim str As String
Dim v As Variant
Dim i As Long
Dim w As Single
If ChkCondition = False Then
MsgBox "ソースコードを選択した状態で実行してください。", vbExclamation + vbSystemModal
Exit Sub
End If
Application.ScreenUpdating = False
Set ur = Application.UndoRecord
ur.StartCustomRecord "ソースコード変換処理"
On Error GoTo Err:
'最後の改行を選択範囲から外す
Select Case AscW(Selection.Characters.Last)
Case &HB, &HD: Selection.MoveEnd wdCharacter, -1
End Select
str = Selection.Text
str = Replace(str, ChrW(&HB), ChrW(&HD)) '段落内改行置換
v = Split(str, ChrW(&HD))
Set tbl = Selection.Tables.Add(Selection.Range, UBound(v) + 1, 2)
'フォント設定
With tbl.Range.Font
.Size = 10
.NameFarEast = "ＭＳ ゴシック"
.NameAscii = "ＭＳ ゴシック"
.NameOther = "ＭＳ ゴシック"
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
End With
'段落設定
With tbl.Range.ParagraphFormat
.LineSpacingRule = wdLineSpaceSingle '行間：1行
.WordWrap = False '[英単語の途中で改行する]にチェック
End With
For i = LBound(v) To UBound(v)
tbl.Cell(i + 1, 1).Range.Text = i + 1
tbl.Cell(i + 1, 2).Range.Text = v(i)
Next
'幅設定
tbl.AutoFitBehavior wdAutoFitWindow
w = tbl.Columns(1).Width + tbl.Columns(2).Width
tbl.Columns(1).Width = 35
tbl.Columns(2).Width = w - 35
'配置設定
tbl.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
tbl.Range.ParagraphFormat.Alignment = wdAlignParagraphJustify
'罫線設定
With tbl.Borders
.OutsideColor = wdColorAutomatic
.OutsideLineStyle = wdLineStyleSingle
.OutsideLineWidth = wdLineWidth050pt
End With
With tbl.Borders(wdBorderHorizontal)
.Color = wdColorAutomatic
.LineStyle = wdLineStyleDot
.LineWidth = wdLineWidth050pt
End With
With tbl.Columns(1).Borders(wdBorderRight)
.Color = wdColorAutomatic
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
End With
'背景色設定
With tbl.Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = &HDC00F2FF
End With
'行番号列書式設定
tbl.Columns(1).Shading.BackgroundPatternColor = &H333333
tbl.Columns(1).Select
Selection.Font.Color = &HFFFFFF
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Collapse wdCollapseStart
Err:
If Not ur Is Nothing Then
If ur.IsRecordingCustomRecord = True Then ur.EndCustomRecord
End If
Application.ScreenUpdating = True
End Sub
Private Function ChkCondition() As Boolean
'プロシージャが実行できる状況なのかを確認
Dim ret As Boolean
Dim chrs As Variant
Dim tmp As String
Dim i As Long
ret = True '初期化
If Selection.Type <> wdSelectionNormal Then ret = False 'テキストが選択状態にあるかを確認
tmp = Selection.Text
'改行と空白文字のコード
'空白： http://en.wikipedia.org/wiki/Space_%28punctuation%29 参照
chrs = Array(&HB, &HD, &H20, &HA0, &H1680, &H180E, &H2000, &H2001, &H2002, &H2003, _
&H2004, &H2005, &H2006, &H2007, &H2008, &H2009, &H200A, &H200B, &H200C, &H200D, _
&H202F, &H205F, &H2060, &H3000, &HFEFF)
For i = LBound(chrs) To UBound(chrs)
tmp = Replace(tmp, ChrW(chrs(i)), "")
Next
If Len(tmp) < 1 Then ret = False
ChkCondition = ret
End Function
ソースコードを選択した状態で上記マクロを実行すると、ソースコードが下図のように行番号付きのテーブルに変換されます。
以前のマクロとの大きな違いは、下図のように折り返されている行も一行としている点と、UndoRecordオブジェクトを使うことによって、マクロで行っている一連の表化処理を後から一括で元に戻せるようにしている点です。
UndoRecordオブジェクトは、Word 2010で追加された機能であるため、それ以前のWordでは動作しませんが、使い方によっては非常に便利なオブジェクトです。
大変助かりました。
本当にありがとうございます！！