Excel操作のセル色指定使う機会あったんだけどRGBで指定する形になってた。
RGBの数値見ても何色になるのかよくわかんないなーと思ったから色名で指定できる様にしてみた。
色名の一覧はこちらから。
１．セルの文字色・背景色を色名で指定
いつもの如く、スクリプト実行ステージのスクリプトタブに張り付ければすぐに使えるスクリプトです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 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 |
２．設定画面こんな感じ。
