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

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

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

  2. アイコン一覧

    Office 2013 アイコン一覧(P)

    ・Office 2013 アイコン一覧 NUM…

  3. Office関連

    アクティブなIEのタブを閉じるVBAマクロ

    「VBA アクティブ IE タブ 閉じる」といったキーワード検索でのア…

  4. Office関連

    [リボン・カスタマイズ]グループの表示・非表示をトグルボタンで切り替える。

    数年前に書いた記事に下記コメントをいただきました。Excelに…

  5. Office関連

    YouTube動画挿入アドイン for PowerPoint

    前回の記事でPowerPoint 2013でYouTubeの動画が挿入…

  6. Office関連

    段落内改行を一括置換するOutlookマクロ

    「段落内改行 置換 Outlook マクロ」といったキーワードでのアク…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP