ハイライト3

ようやくどのブックへもハイライトが反映できるようになりました。

Sub ハイライト()
　　Dim Cnd As FormatConditions, qest As Integer
　　Dim i As Integer
　　With Cells
　　Set Cnd = .FormatConditions
　　If Cnd.count >= 1 Then '条件付書式設定の有無
　　　　qest = MsgBox("すでに別の条件付き書式が" _
　　　　　　　　& vbLf & _
　　　　　　　　"設定されています。" _
　　　　　　　　& vbLf & _
　　　　　　　　"実行しますか？", _
　　　　　　　　vbYesNo + vbExclamation + vbDefaultButton2, _
　　　　　　　　"条件付き書式の確認")
　　End If
　　If qest = vbNo Then
　　　　Exit Sub
　　End If
　　For i = Cnd.count To 1 Step -1 '条件付書式をクリア
　　　　.FormatConditions(i).Delete
　　Next i

　　'条件付書式設定
　　　　Cnd.Add Type:=xlExpression, _
　　　　　　Formula1:="=CELL(""address"")=ADDRESS(ROW(),COLUMN())"
　　　　Cnd.Add Type:=xlExpression, _
　　　　　　Formula1:="=CELL(""row"")=ROW()"
　　　　Cnd.Add Type:=xlExpression, _
　　　　　　Formula1:="=CELL(""col"")=COLUMN()"

　　.FormatConditions(1).Font.Bold = True
　　.FormatConditions(2).Interior.ColorIndex = 34
　　.FormatConditions(3).Interior.ColorIndex = 36
　　End With

　　On Error GoTo Fin
　　'イヴェントマクロ記述
　　With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
　　　　.DeleteLines .ProcBodyLine("Workbook_SheetSelectionChange", 0),
.ProcCountLines("Workbook_SheetSelectionChange", 0)
Fin:
　　　　.AddFromString _
　　　　　　"Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)" _
　　　　　　& vbLf & vbTab & _
　　　　　　　　"Application.ScreenUpdating = True" _
　　　　　　& vbLf & _
　　　　　　"End Sub"
　　End With
End Sub

このハイライト、職場の人間にとても評判がいい、いいんですけど別のブックを開くたびにその設定をやってくれと呼ばれます。

ちょっと大げさだけどこれをそれぞれの同僚のExcelのPersonal.xlsに仕込んでメニューにもアイコンを忍ばせれば・・・・と目論んでいます。