Office関連

【2018年7月版】ソースコードを番号行付きのテーブルに変換するWordマクロ

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 = "MS ゴシック"
    .NameAscii = "MS ゴシック"
    .NameOther = "MS ゴシック"
    .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では動作しませんが、使い方によっては非常に便利なオブジェクトです。

関連記事

  1. Excel

    「EXCEL VBA 業務自動化 仕事の効率を劇的に上げるノウハウ」レビュー

    ※ 下記レビューはあくまでも個人的な感想です。2015年4…

  2. Excel

    Acrobatを利用してPDFファイルのページ数を取得するVBAマクロ

    前回の記事ではPowerShell+iTextSharp、前々回の記事…

  3. Office関連

    PowerPoint 2013でYouTubeの動画を挿入する。

    2014/5/23 追記:いつの間にか「ビデオの挿入ダイアログ」が…

  4. Excel

    Adobe Readerを利用してPDFファイルのページ数を取得するVBAマクロ

    mougの回答用に書いたコードです。mougは半年でログが消えてし…

  5. Office関連

    「クラシックスタイルメニュー for Office 2010」のOffice 2013対応状況

    私が下記ページで公開しているフリーソフト「クラシックスタイルメニュー …

  6. Excel

    Faviconをダウンロードするマクロ

    WebサイトからFaviconを抜き出すAPIがあったので早速使ってみ…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP