[WinActor]Excel操作 文字色・セル色の色名指定

Excel操作のセル色指定使う機会あったんだけどRGBで指定する形になってた。

RGBの数値見ても何色になるのかよくわかんないなーと思ったから色名で指定できる様にしてみた。

色名の一覧はこちらから。

MSDN - XlRgbColor 列挙 (Excel)

１．セルの文字色・背景色を色名で指定

いつもの如く、スクリプト実行ステージのスクリプトタブに張り付ければすぐに使えるスクリプトです。

' ====指定されたファイルを開く====================================================

' ファイルのパスをフルパスに変換する
Set fso = CreateObject("Scripting.FileSystemObject")
filePath = fso.GetAbsolutePathName(!ファイル名!)

' ExcelWorkBookオブジェクトを取得する
Set ExcelWorkBook = Nothing
On Error Resume Next
  ' 既存のエクセルが起動されていれば警告を抑制する
  Set existingXlsApp = Nothing
  Set existingXlsApp = GetObject(, "Excel.Application")
  existingXlsApp.DisplayAlerts = False

  ' 一先ずWorkbookオブジェクトをGetObjectしてみる
  Set ExcelWorkBook = GetObject(filePath)
  Set xlsApp = ExcelWorkBook.Parent

  ' GetObjectによって新規に開かれたWorkbookなら
  ' 変数にNothingを代入することで参照が0になるため
  ' 自動的に閉じられる。
  Set ExcelWorkBook = Nothing

  ' Workbookがまだ存在するか確認する
  For Each book In xlsApp.Workbooks
    If StrComp(book.FullName, filePath, 1) = 0 Then
      ' Workbookがまだ存在するので、このWorkbookは既に開かれていたもの
      Set ExcelWorkBook = book
      xlsApp.Visible = True
    End If
  Next

  ' Workbookが存在しない場合は、新たに開く。
  If ExcelWorkBook Is Nothing Then
    Set xlsApp = Nothing

    ' Excelが既に開かれていたならそれを再利用する
    If Not existingXlsApp Is Nothing Then
      Set xlsApp = existingXlsApp
      xlsApp.Visible = True
    Else
      Set xlsApp = CreateObject("Excel.Application")
      xlsApp.Visible = True
    End If

    Set ExcelWorkBook = xlsApp.Workbooks.Open(filePath)
  End If

  ' 警告の抑制を元に戻す
  existingXlsApp.DisplayAlerts = True
  Set existingXlsApp = Nothing
On Error Goto 0

If ExcelWorkBook Is Nothing Then
  Err.Raise 1, "", "指定されたファイルを開くことができません。"
End If

' ====指定されたシートを取得する==================================================

sheetName = !シート名!
Set worksheet = Nothing
On Error Resume Next
  ' シート名が指定されていない場合は、アクティブシートを対象とする
  If sheetName = "" Then
    Set worksheet = ExcelWorkBook.ActiveSheet
  Else
    Set worksheet = ExcelWorkBook.Worksheets(sheetName)
  End If
On Error Goto 0

If worksheet Is Nothing Then
  Err.Raise 1, "", "指定されたシートが見つかりません。"
End If

worksheet.Activate

' ====指定されたセル位置をアクティブ化する==================================================

cellAddress = !セル位置!
Set cell = Nothing
On Error Resume Next
  ' R1C1形式にも対応する。
  Set objRE = CreateObject("VBScript.RegExp")
  objRE.IgnoreCase = True
  objRE.Pattern = "^R(\d+)C(\d+)$"
  Set matches = objRE.Execute(cellAddress)

  If matches.Count = 0 Then
    Set cell = worksheet.Range(cellAddress)
  Else
    Set cell = worksheet.Cells(matches(0).SubMatches(0) + 0, matches(0).SubMatches(1) + 0)
  End If
On Error Goto 0

If cell Is Nothing Then
  Err.Raise 1, "", "指定されたセルが見つかりません。"
End If

cell.Activate

' ====ハイライトを表示する========================================================

' HwndプロパティはExcel2002以降のみ対応
On Error Resume Next
  ShowUMSHighlight(xlsApp.Hwnd)
On Error Goto 0

' ====色を付ける====================================================

TargetProperty = !設定先|文字色,背景色!

' 色名の参考：https://docs.microsoft.com/ja-jp/office/vba/api/excel.xlrgbcolor?redirectedfrom=MSDN
ColorName = !色指定|塗りつぶしなし,アリスブルー,アンティークホワイト,水色,アクアマリン,空色,ベージュ,ビスク,黒,ブランシュアーモンド,青,青紫,茶,バーリーウッド,カデットブルー,シャルトルーズ,さんご,コーンフラワーブルー,コーンシルク,深紅,濃い青,濃いシアン,濃いゴールデンロッド,濃い灰色,濃い緑,濃い灰色,濃いカーキ,濃いマゼンタ,濃いオリーブグリーン,濃いオレンジ,濃いオーキッド,濃い赤,濃いサーモンピンク,濃いシーグリーン,濃いスレートブルー,濃いスレートグレー,濃いスレートグレー,濃いターコイズ,濃い紫,深いピンク,深いスカイブルー,ディムグレー,ディムグレー,ドジャーブルー,れんが色,フローラルホワイト,フォレストグリーン,明るい紫,ゲーンズボロ,ゴーストホワイト,ゴールド,ゴールデンロッド,灰色,緑,グリーンイエロー,灰色,ハニーデュー,ホットピンク,インディアンレッド,インディゴ,アイボリー,カーキ,ラベンダー,ラベンダーブラッシュ,若草色,レモンシフォン,明るい青,薄いさんご,明るい水色,LightGoldenrodYellow,薄い灰色,明るい緑,薄い灰色,薄いピンク,薄いサーモンピンク,薄いシーグリーン,薄いスカイブルー,薄いスレートグレー,薄いスチールブルー,明るい黄,黄緑,ライムグリーン,リネン,栗色,淡いアクアマリン,淡い青,淡いオーキッド,淡い紫,淡いシーグリーン,淡いスレートブルー,淡いスプリンググリーン,淡いターコイズ,淡いバイオレットレッド,ミッドナイトブルー,ミントクリーム,ミスティローズ,モカシン,ナバホホワイト,ネイビー,ネイビーブルー,オールドレース,オリーブ,オリーブドラブ,オレンジ,オレンジレッド,オーキッド,ペールゴールデンロッド,ペールグリーン,ペールターコイズ,ペールバイオレットレッド,パパイヤホイップ,ピーチパフ,ペルー,ピンク,プラム,パウダーブルー,紫,赤,ローズブラウン,ロイヤルブルー,サーモンピンク,サンディブラウン,シーグリーン,シーシェル,シェンナ,銀色,スカイブルー,スレートブルー,スレートグレー,スノー,スプリンググリーン,スチールブルー,タン,青緑,あざみ色,トマト,ターコイズ,紫色,小麦,白,ホワイトスモーク,黄,イエローグリーン!

If ColorName = "塗りつぶしなし" Then
  Select Case TargetProperty
    Case "文字色"
      cell.Font.ColorIndex = 0
    Case "背景色"
      cell.Interior.ColorIndex = 0
  End Select
Else
  AryColorName = Array("アリスブルー","アンティークホワイト","水色","アクアマリン","空色","ベージュ","ビスク","黒","ブランシュアーモンド","青","青紫","茶","バーリーウッド","カデットブルー","シャルトルーズ","さんご","コーンフラワーブルー","コーンシルク","深紅","濃い青","濃いシアン","濃いゴールデンロッド","濃い灰色","濃い緑","濃い灰色","濃いカーキ","濃いマゼンタ","濃いオリーブグリーン","濃いオレンジ","濃いオーキッド","濃い赤","濃いサーモンピンク","濃いシーグリーン","濃いスレートブルー","濃いスレートグレー","濃いスレートグレー","濃いターコイズ","濃い紫","深いピンク","深いスカイブルー","ディムグレー","ディムグレー","ドジャーブルー","れんが色","フローラルホワイト","フォレストグリーン","明るい紫","ゲーンズボロ","ゴーストホワイト","ゴールド","ゴールデンロッド","灰色","緑","グリーンイエロー","灰色","ハニーデュー","ホットピンク","インディアンレッド","インディゴ","アイボリー","カーキ","ラベンダー","ラベンダーブラッシュ","若草色","レモンシフォン","明るい青","薄いさんご","明るい水色","LightGoldenrodYellow","薄い灰色","明るい緑","薄い灰色","薄いピンク","薄いサーモンピンク","薄いシーグリーン","薄いスカイブルー","薄いスレートグレー","薄いスチールブルー","明るい黄","黄緑","ライムグリーン","リネン","栗色","淡いアクアマリン","淡い青","淡いオーキッド","淡い紫","淡いシーグリーン","淡いスレートブルー","淡いスプリンググリーン","淡いターコイズ","淡いバイオレットレッド","ミッドナイトブルー","ミントクリーム","ミスティローズ","モカシン","ナバホホワイト","ネイビー","ネイビーブルー","オールドレース","オリーブ","オリーブドラブ","オレンジ","オレンジレッド","オーキッド","ペールゴールデンロッド","ペールグリーン","ペールターコイズ","ペールバイオレットレッド","パパイヤホイップ","ピーチパフ","ペルー","ピンク","プラム","パウダーブルー","紫","赤","ローズブラウン","ロイヤルブルー","サーモンピンク","サンディブラウン","シーグリーン","シーシェル","シェンナ","銀色","スカイブルー","スレートブルー","スレートグレー","スノー","スプリンググリーン","スチールブルー","タン","青緑","あざみ色","トマト","ターコイズ","紫色","小麦","白","ホワイトスモーク","黄","イエローグリーン")
  AryColorVal = Array(16775408,14150650,16776960,13959039,16777200,14480885,12903679,0,13495295,16711680,14822282,2763429,8894686,10526303,65407,5275647,15570276,14481663,3937500,9109504,9145088,755384,11119017,25600,11119017,7059389,9109643,3107669,36095,13382297,139,8034025,9419919,9125192,5197615,5197615,13749760,13828244,9639167,16760576,6908265,6908265,16748574,2237106,15792895,2263842,16711935,14474460,16775416,55295,2139610,8421504,32768,3145645,8421504,15794160,11823615,6053069,8519755,15794175,9234160,16443110,16118015,64636,13499135,15128749,8421616,9145088,13826810,13882323,9498256,13882323,12695295,8036607,11186720,16436871,10061943,14599344,14745599,65280,3329330,15134970,128,11206502,13434880,13850042,14381203,7451452,15624315,10156544,13422920,8721863,7346457,16449525,14804223,11920639,11394815,8388608,8388608,15136253,32896,2330219,42495,17919,14053594,7071982,10025880,15658671,9662683,14020607,12180223,4163021,13353215,14524637,15130800,8388736,255,9408444,14772545,7504122,6333684,5737262,15660543,2970272,12632256,15453831,13458026,9470064,16448255,8388352,11829830,9221330,8421376,14204888,4678655,13688896,15631086,11788021,16777215,16119285,65535,3329434)

  For i=0 To UBound(AryColorName)
    If ColorName = AryColorName(i) Then
      ColorVal = AryColorVal(i)
      Exit For
    End If
  Next

  Select Case TargetProperty
    Case "文字色"
      cell.Font.Color = ColorVal
    Case "背景色"
      cell.Interior.Color = ColorVal
  End Select
End If

Set xlsApp = Nothing
Set existingXlsApp = Nothing
Set ExcelWorkBook = Nothing
Set Excelworksheet = Nothing
Set sheetName = Nothing
Set sheetPos = Nothing
Set fso = Nothing
Set filePath = Nothing

２．設定画面こんな感じ。