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. Office アドイン

    [Office用アプリ]アプリ開発コンテスト・受賞者発表

    以前書いた記事でお知らせしていた「Apps for Office アプ…

  2. Office関連

    ガイドを追加するPowerPointマクロ

    PowerPointで図形の位置を調整するときに役立つガイド機能(ガイ…

  3. Office関連

    Office 2013のコントロールIDリストが更新されました。

    「コントロールID 一覧(Office 2013)」でも紹介しているO…

  4. Office関連

    SmartArtからテキストを取得するPowerPointマクロ

    Twitterで@terrysaitoさんが下記のようなツイートをされ…

  5. Office関連

    Data Explorerのフォーラム&ブログ

    前回の記事で紹介した「Data Explorer」ですが、すでにフォー…

コメント

  • コメント (1)

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

    • HK
    • 2022年 12月 18日 11:34am

    大変助かりました。
    本当にありがとうございます!!

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP