Attribute VB_Name = "Заливка"
Public Sub 'HighlightCellsReferenced() ' Выделить
    Dim rowCnt As Integer
    Dim i As Integer, j As Integer, strleng As Integer
    Dim strTxt As String, strFml As String
    Dim columnStr, cellsAddress As String
    Dim xRg As Range, yRg As Range
    On Error Resume Next
    Set xRg = Application.InputBox(Prompt:="Пожалуйста, выберите ячейки (у) с формулой...", _
    Title:="Выбор ячеек", Type:=8)
    ClsCLR = PickNewColor
    strTxt = ""
    Application.ScreenUpdating = False
    For Each yRg In xRg
        Set prCell = yRg
        On Error Resume Next
        Set prCell = Union(yRg, yRg.DirectPrecedents)
        prCell.Interior.Color = ClsCLR
    Next yRg
    xRg.Interior.Color = ClsCLR
    Application.ScreenUpdating = True
End Sub

Public Sub 'De_HighlightCellsReferenced() ' Снять выделение (прозрачный)
    Dim rowCnt As Integer
    Dim i As Integer, j As Integer, strleng As Integer
    Dim strTxt As String, strFml As String
    Dim columnStr, cellsAddress As String
    Dim xRg As Range, yRg As Range
    On Error Resume Next
    Set xRg = Application.InputBox(Prompt:="Пожалуйста, выберите ячейки(у) с формулой...", _
    Title:="Выбор ячеек", Type:=8)
    ClsCLR = -4142
    strTxt = ""
    Application.ScreenUpdating = False
    For Each yRg In xRg
        Set prCell = yRg
        On Error Resume Next
        Set prCell = Union(yRg, yRg.DirectPrecedents)
        prCell.Interior.Color = ClsCLR
    Next yRg
    xRg.Interior.Color = ClsCLR
    Application.ScreenUpdating = True
End Sub

Function PickNewColor(Optional ByVal i_OldColor As Double = xlNone) As Double
    ' функция отображает диалоговое окно выбора цвета заливки
    ' и возвращает значение выбранного цвета
    On Error Resume Next:
    PickNewColor = i_OldColor
    Const BGColor As Long = 13160660, ColorIndexLast As Long = 32
    Dim myOrgColor As Double, myNewColor As Double, WB As Workbook
    Dim myRGB_R As Integer, myRGB_G As Integer, myRGB_B As Integer
    If ActiveWorkbook Is Nothing Then Application.ScreenUpdating = False: Set WB = Workbooks.Add
    myOrgColor = ActiveWorkbook.Colors(ColorIndexLast)    'save original palette color

    i_Color = IIf(i_OldColor = xlNone, BGColor, i_OldColor): myRGB_R = i_Color Mod 256
    i_Color = i_Color \ 256: myRGB_G = i_Color Mod 256
    i_Color = i_Color \ 256: myRGB_B = i_Color Mod 256
    ActiveWorkbook.ResetColors    'AppActivate Application.Name
    If Application.Dialogs(xlDialogEditColor).Show(ColorIndexLast, myRGB_R, myRGB_G, myRGB_B) Then
        PickNewColor = ActiveWorkbook.Colors(ColorIndexLast)
        ThisWorkbook.Colors(ColorIndexLast) = myOrgColor
    End If
    If Not WB Is Nothing Then WB.Close False: Application.ScreenUpdating = True
End Function