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

【2018年7月版】SeleniumBasicでMicrosoft Edgeを操作してみました。前のページ

2018年7月の人気記事次のページ

関連記事

  1. Excel

    Excel REST APIをPowerShellから呼び出す方法

    以前Excel REST APIをVBAから呼び出す方法を紹介しました…

  2. アイコン一覧

    Office 2013 アイコン一覧(B)

    ・Office 2013 アイコン一覧 NUM…

  3. アイコン一覧

    Office 2013 アイコン一覧(J)

    ・Office 2013 アイコン一覧 NUM…

  4. Office関連

    VBAプロジェクトを「展開する」VBAマクロ

    MSDNフォーラムに面白い質問がありました。VBE・プロジェクト …

  5. Office関連

    セルの行数をカウントするWordマクロ

    「ソースコードを番号行付きのテーブルに変換するWordマクロ」を実行し…

  6. Office アドイン

    [Office用アプリ]Bing Maps for Accessの紹介

    Microsoft Download CenterでAccess向けO…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

Chinese (Simplified)Chinese (Traditional)EnglishFrenchGermanJapaneseKoreanRussianSpanish

最近の記事

アーカイブ

PAGE TOP