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関連

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

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

  2. Office関連

    「Office 2003 のコマンドに対応する Office 2010 のリファレンス ブック」のダ…

    クリックさんのブログ記事「旧メニュー対応表を使いたい: パソコンのツボ…

  3. Office関連

    IEサポート終了でVBAマクロはどうなるの?

    ※下記情報は2021年5月時点の情報で、今後状況が変わっていく可能性が…

  4. Office関連

    Google翻訳で文字列を翻訳するVBAマクロ(IE操作版)

    下記記事にあるように、ニューラルネット機械翻訳の導入によって、Goog…

  5. Office アドイン

    [Office用アプリ]アプリ開発コンテストの案内

    2013/9/9 追記:コンテストの受賞者が発表されました。おかげ…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP