Office関連

テーブルの罫線色情報を列挙するPowerPointマクロ

テーブルが多いプレゼンテーションファイルの、各テーブルの線の色の情報を調べる必要があったので、マクロでまとめて取得してみました。

Option Explicit

Public Sub Sample()
'アクティブなスライドにあるテーブルの罫線色情報を列挙
  Dim shp As PowerPoint.Shape
  Dim c As Long, r As Long
  
  For Each shp In ActiveWindow.Selection.SlideRange.Shapes
    If shp.HasTable = True Then
      With shp.Table
        For r = 1 To .Rows.Count
          For c = 1 To .Columns.Count
            Debug.Print shp.Name & ", " & _
                        "セル(" & r & ", " & c & "), " & _
                        "上線色:" & GetRGBColor(.Cell(r, c).Borders(ppBorderTop).ForeColor) & ", " & _
                        "左線色:" & GetRGBColor(.Cell(r, c).Borders(ppBorderLeft).ForeColor) & ", " & _
                        "下線色:" & GetRGBColor(.Cell(r, c).Borders(ppBorderBottom).ForeColor) & ", " & _
                        "右線色:" & GetRGBColor(.Cell(r, c).Borders(ppBorderRight).ForeColor) & ", " & _
                        "下斜め線色:" & GetRGBColor(.Cell(r, c).Borders(ppBorderDiagonalDown).ForeColor) & ", " & _
                        "上斜め線色:" & GetRGBColor(.Cell(r, c).Borders(ppBorderDiagonalUp).ForeColor)
          Next
        Next
      End With
    End If
  Next
End Sub

Private Function GetRGBColor(ByVal col As Long) As String
'RGB取得
  Dim hex_col As String
  
  hex_col = Hex(col)
  hex_col = Right("000000" & hex_col, 6)
  GetRGBColor = "Red:" & CLng("&H" & Right(hex_col, 2)) & _
                ", Green:" & CLng("&H" & Mid(hex_col, 3, 2)) & _
                ", Blue:" & CLng("&H" & Left(hex_col, 2))
End Function

GetTableBorderColor_01

GetTableBorderColor_02

適当に書いたので処理は雑になっていますが、とりあえず目的は達成できました。

Unicodeブロックを元に指定した文字が平仮名なのかカタカナなのか漢字なのかを判別するVBAマクロ前のページ

ファイルをブックに埋め込むExcelマクロ次のページ

関連記事

  1. Office関連

    VBAからRegistration-Freeで.NETベースのDLLを呼び出す方法

    C#製のDLLをVBAから呼び出すのにいちいちRegAsmするのも面倒…

  2. Office関連

    「NetOffice」で簡単に.NETからOfficeを操作

    ネットで「NetOffice」なるツールがあることを知ったので、早速試…

  3. Excel

    【2017年7月版】ポータブル デバイスからファイルをコピーするVBAマクロ

    4年ほど前に、PCに接続したスマートフォン等のWindows ポータブ…

  4. Office関連

    名前空間を指定してXPathで要素を取得するVBAマクロ

    Tech Communityに、“XPathで名前空間プレフィックス付…

  5. Office関連

    「もし宇宙人が地球レポートをまとめたら」動画公開

    PLAY! Office第三弾、「もし宇宙人が地球レポートをまとめたら…

コメント

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

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP