月曜日, 1月 27, 2025

Excel VBA 37 
Excelで選択したセルが塗り潰しなら太字

Excelで選択したセルのなかで、セルが塗り潰されているばあい、そのセルの文字を太字にします。

Sub MakeBoldForColoredCells()
Dim rng As Range
Dim cell As Range
' 選択範囲を取得
On Error Resume Next
Set rng = Selection
On Error GoTo 0
' 選択範囲がない場合は終了
If rng Is Nothing Then
MsgBox "選択範囲を指定してください。", vbExclamation
Exit Sub
End If
' 範囲内の各セルを処理
' Application.ScreenUpdating = Falseで
' 画面更新を停止し、処理を高速化
Application.ScreenUpdating = False
For Each cell In rng
' セルが塗りつぶしされており、色が設定されている場合、
' cell.Interior.Color を使用して、セルの塗りつぶし色を判定。
' 塗りつぶしが「透明(色なし)」または xlNone の場合はスキップ。
' 16777215 は標準の白色(RGB値: 255, 255, 255)を指す。
' 背景が白色の場合も無視するよう条件を追加。
' 塗りつぶしが色付きの場合のみ、cell.Font.Bold = True を設定
If cell.Interior.Color <> _
16777215 And cell.Interior.Color <> xlNone Then
cell.Font.Bold = True ' 文字をボールドに変更
End If
Next cell
Application.ScreenUpdating = True
MsgBox "色付きのセルの文字をボールドに変更しました。", _
vbInformation
End Sub

白も塗り潰しになってしまうことに気がつかず苦労しました。セルを選択し・・・

実行した結果です。
元に戻すときは、以下で対処してください。

Sub MakeTextNormal()
Dim rng As Range
Dim cell As Range
' 選択範囲を取得
On Error Resume Next
Set rng = Selection
On Error GoTo 0
' 選択範囲がない場合は終了
If rng Is Nothing Then
MsgBox "選択範囲を指定してください。", vbExclamation
Exit Sub
End If
' 範囲内の各セルを処理
Application.ScreenUpdating = False
For Each cell In rng
If Not IsEmpty(cell) Then
cell.Font.Bold = False ' ボールドをオフ
cell.Font.Italic = False ' イタリックをオフ
cell.Font.Underline = xlUnderlineStyleNone ' 下線をオフ
End If
Next cell
Application.ScreenUpdating = True
MsgBox "選択範囲の文字をノーマルに変更しました。", vbInformation
End Sub