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

yizm

5年前

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

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

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

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

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

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

' ファイルのパスをフルパスに変換する
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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

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

' ファイルのパスをフルパスに変換する

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

' 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

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

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

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