توابع رنگ در اکسل

اکسل اساساً هیچ پشتیبانی در توابع کاربرگ برای کار با رنگ های سلولی ارائه نمی دهد. با این حال، رنگ ها اغلب در صفحات گسترده برای نشان دادن نوعی ارزش یا دسته استفاده می شوند. بنابراین نیاز به توابعی است که می تواند با رنگ ها در کاربرگ کار کند. این صفحه تعدادی از توابع را برای VBA توصیف می کند که می توانند از سلول های کاربرگ یا سایر رویه های VBA فراخوانی شوند.

معرفی سریع رنگ ها

مانند هر چیز دیگری در رایانه، یک رنگ در واقع فقط یک عدد است. هر رنگی که می تواند بر روی صفحه نمایش کامپیوتر نمایش داده شود بر حسب سه جزء اصلی تعریف می شود: یک جزء قرمز، یک جزء سبز و یک جزء آبی. در مجموع، این مقادیر به عنوان مقادیر RGB شناخته می شوند. مدل رنگی RGB مدل «افزودنی» نامیده می‌شود، زیرا رنگ‌های غیراصولی دیگر، مانند بنفش، از ترکیب رنگ‌های اصلی قرمز، سبز و آبی در درجات مختلف ایجاد می‌شوند. به عنوان مثال، بنفش تقریباً یک قرمز با شدت نیمه به اضافه یک آبی با شدت نیمه است. هر جزء رنگ اصلی به عنوان یک عدد بین 0 تا 255 (یا به صورت هگز، &H00 تا &HFF) ذخیره می شود. یک رنگ یک عدد 4 بایتی با فرمت 00BBGGRR است که مقادیر RR، GG و BB مقادیر قرمز، سبز و آبی هستند که هر کدام بین 0 تا 255 (&HFF) هستند. اگر تمام مقادیر مؤلفه 0 باشد، رنگ RGB 0 است که سیاه است. اگر همه مقادیر مؤلفه 255 (&HFF) باشد، رنگ RGB 16777215 (&H00 FFFFFF) یا سفید است. همه رنگ های دیگر ترکیبی از مقادیر برای اجزای قرمز، سبز و آبی هستند. تابع VBA RGB را می توان برای ترکیب مقادیر قرمز، سبز و آبی به یک مقدار رنگ RGB استفاده کرد.

نکته استفاده: در این صفحه برای اشاره به پس‌زمینه یک سلول، از عبارت‌های پس‌زمینه، پر و داخلی به جای یکدیگر استفاده می‌شود. اصطلاح مناسب، ویژگی داخلی یک شی محدوده است.

ارزش جلب توجه به مقادیر مؤلفه در مقدار Long RGB را دارد. ترتیب رنگ‌ها از چپ به راست که در مقدار RGB ذخیره می‌شوند آبی، سبز، قرمز است. این برعکس حروف در نام RGB است. این را در هنگام استفاده از حروف هگزا برای تعیین رنگ در نظر داشته باشید.

پالت رنگ

اکسل از رنگ‌ها برای فونت‌ها و پر کردن پس‌زمینه از طریق آنچه که پالت رنگ نامیده می‌شود، پشتیبانی می‌کند. پالت یک آرایه یا سری از 56 رنگ RGB است. ارزش هر یک از آن 56 رنگ ممکن است هر یک از 16 میلیون رنگ موجود باشد، اما پالت، و بنابراین تعداد رنگ های متمایز در یک کتاب کار، به 56 رنگ محدود می شود. مقادیر RGB در پالت با ویژگی ColorIndex یک شی Font (برای رنگ فونت) یا شی داخلی (برای رنگ پس‌زمینه) قابل دسترسی است. ColorIndex یک افست یا شاخص در پالت است و بنابراین دارای مقداری بین 1 و 56 است. در پالت پیش‌فرض و اصلاح نشده، عنصر سوم در پالت مقدار RGB 255 (&HFF) است که قرمز است.

برای مثال، وقتی پس‌زمینه سلولی را به رنگ قرمز فرمت می‌کنید، در واقع مقدار 3 را به ویژگی ColorIndex داخلی اختصاص می‌دهید. اکسل عدد 3 را در ویژگی ColorIndex می‌خواند، به عنصر سوم پالت می‌رود تا RGB واقعی را دریافت کند. رنگ اگر پالت را تغییر دهید، مثلاً با تغییر عنصر سوم از قرمز (255 = &HFF) به آبی (16,711,680 = &HFF0000)، همه مواردی که زمانی قرمز بودند اکنون آبی هستند. این به این دلیل است که ویژگی ColorIndex برابر با 3 است، اما مقدار عنصر سوم در پالت از قرمز به آبی تغییر کرده است.

شما مقادیر موجود در پالت پیش فرض را با تغییر آرایه Colors شی Workbook تغییر می دهید. به عنوان مثال، برای تغییر رنگ ارجاع شده توسط مقدار ColorIndex 3 به آبی، از استفاده کنید
 

Workbooks("SomeBook.xls").Colors(3) = RGB(0,0,255)

علاوه بر 56 رنگ موجود در پالت، دو مقدار خاص برای رنگ ها استفاده می شود که در ادامه با آن ها مواجه خواهیم شد. اینها xlColorIndexNone هستند که مشخص می‌کند هیچ رنگی اختصاص داده نشده است، و xlColorIndexAutomatic، که مشخص می‌کند یک رنگ پیش‌فرض سیستم (معمولاً سیاه) باید استفاده شود.

توجه: این توابع فقط با پالت 56 رنگ اکسل کار می کنند. آن‌ها از رنگ‌های تم یا رنگ‌هایی که در پالت 56 رنگ نیستند یا رنگ‌هایی که نتیجه قالب‌بندی شرطی هستند پشتیبانی نمی‌کنند.

نمایش پالت کتاب کار فعلی

می توانید از کدهای بسیار ساده برای نمایش تنظیمات فعلی پالت رنگ استفاده کنید. کد زیر رنگ 56 سلول اول کاربرگ فعال را به رنگ های پالت تغییر می دهد. شماره ردیف همان عدد شاخص رنگ است. بنابراین، سلول A3 که در ردیف 3 قرار دارد، رنگی خواهد بود که به شاخص رنگ 3 اختصاص داده شده است.

Sub Displaypalette()
    Dim N As Long
    For N = 1 To 56
        Cells(N, 1).Interior.ColorIndex = N
    Next N
End Sub

اگر با استفاده از Workbook.Colors پالت کتاب کار را تغییر داده اید، می توانید با Workbooks("SomeBook.xls").ResetColors پالت را به مقادیر پیش فرض بازگردانید.

نگ ها در یک سلول یا محدوده

این بحث در مورد رنگ ها، پالت رنگ و ویژگی ColorIndex ما را به عملکرد اساسی اکثر کدهایی که در این صفحه توضیح داده شده است هدایت می کند. تابع ColorIndexOfOneCell شاخص رنگ پس زمینه یا فونت یک سلول را برمی گرداند. بیانیه رویه در زیر نشان داده شده است.

Function ColorIndexOfOneCell(Cell As Range, OfText As Boolean, DefaultColorIndex As Long) As Long

در اینجا Cell سلولی است که رنگ آن خوانده می شود. OfText یا True یا False است که نشان می دهد آیا باید شاخص رنگ فونت (OfText = True) یا پس زمینه (OfText = False) را برگردانید. پارامتر DefaultColorIndex یک مقدار شاخص رنگ (1 تا 56) است که اگر رنگ خاصی به فونت (xlColorIndexAutomatic) یا پر کردن پس زمینه (xlColorIndexNone) اختصاص داده نشده باشد، باید برگردانده شود. اگر OfText را روی True تنظیم کنید، به احتمال زیاد باید DefaultColorIndex را روی 1 (سیاه) تنظیم کنید. اگر OfText را روی False تنظیم کنید، باید DefaultColorIndex را روی 2 (سفید) قرار دهید. به عنوان مثال، اگر محدوده A1 دارای یک پس زمینه پر شده برابر با قرمز باشد (ColorIndex = 3)، کد:

Dim Result As Long
Result = ColorIndexOfOneCell(Cell:=Range("A1"), OfText:=False, DefaultColorIndex:=1)

=COLORINDEXOFONECELL(A1,FALSE,1) 

تابع ColorIndexOfOneCell کامل به شرح زیر است:

    Function ColorIndexOfOneCell(Cell As Range, OfText As Boolean, _
        DefaultColorIndex As Long) As Long
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ColorIndexOfOneCell
    ' This returns the ColorIndex of the cell referenced by Cell.
    ' If Cell refers to more than one cell, only Cell(1,1) is
    ' tested. If OfText True, the ColorIndex of the Font property is
    ' returned. If OfText is False, the ColorIndex of the Interior
    ' property is returned. If DefaultColorIndex is >= 0, this
    ' value is returned if the ColorIndex is either xlColorIndexNone
    ' or xlColorIndexAutomatic.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim CI As Long
    
    Application.Volatile True
    If OfText = True Then
        CI = Cell(1, 1).Font.ColorIndex
    Else
        CI = Cell(1, 1).Interior.ColorIndex
    End If
    If CI < 0 Then
        If IsValidColorIndex(ColorIndex:=DefaultColorIndex) = True Then
            CI = DefaultColorIndex
        Else
            CI = -1
        End If
    End If
    
    ColorIndexOfOneCell = CI
    
    End Function

    Private Function IsValidColorIndex(ColorIndex As Long) As Boolean 
        Select Case ColorIndex 
            Case 1 To 56 
                IsValidColorIndex = True 
            Case xlColorIndexAutomatic, xlColorIndexNone  
                IsValidColorIndex = True 
            Case Else 
                IsValidColorIndex = False 
        End Select 
    End Function 

تابع ColorIndexOfOneCell به خودی خود کاربرد محدودی دارد. با این حال، تابع دیگری به نام ColorIndexOfRange استفاده می‌کند که آرایه‌ای از مقادیر شاخص رنگ را برای محدوده‌ای از سلول‌ها برمی‌گرداند. اعلان این تابع در زیر نشان داده شده است:

Function ColorIndexOfRange(InRange As Range, _
                   Optional OfText As Boolean = False, _
                   Optional DefaultColorIndex As Long = -1) As Variant

در اینجا، InRange محدوده ای است که مقادیر رنگ آن باید برگردانده شود. OfText یا True یا False است که نشان می دهد آیا باید شاخص رنگ فونت (OfText = True) یا پر کردن پس زمینه (OfText = نادرست یا حذف شده) سلول های InRange را بررسی کنیم. مقدار DefaultColorIndex یک شاخص رنگ را مشخص می‌کند که اگر مقدار شاخص رنگ واقعی xlColorIndexNone یا xlColorIndexAutomatic باشد، باید برگردانده شود. این تابع آرایه ای از مقادیر شاخص رنگ (1 تا 56) از هر سلول در InRange را به عنوان نتیجه خود برمی گرداند.

می‌توانید ColorIndexOfRange را به‌عنوان یک فرمول آرایه از محدوده‌ای از سلول‌ها فراخوانی کنید تا شاخص‌های رنگ محدوده دیگری از سلول‌ها را برگردانید. مثلاً اگر array-enter کنید

=ColorIndexOfRange(A1:A10,FALSE,1)

در سلول های B1:B10، B1:B10 شاخص های رنگ سلول ها را در A1:A10 فهرست می کند.

کد کامل ColorIndexOfRange در زیر نشان داده شده است

Function ColorIndexOfRange(InRange As Range, _
        Optional OfText As Boolean = False, _
        Optional DefaultColorIndex As Long = -1) As Variant
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ColorIndexFromRange
    ' This function returns an array of values, each of which is
    ' the ColorIndex of a cell in InRange. If InRange contains both
    ' multiple rows and multiple columns, the array is two dimensional,
    ' number of rows x number of columns. If InRange is either a single
    ' row or a single column, the array is single dimensional. If
    ' InRange has multiple rows, the array is transposed before
    ' returning it. The DefaultColorIndex indicates what color
    ' index to value to substitute for xlColorIndexNone and
    ' xlColorIndexAutomatic. If OfText is True, the ColorIndex
    ' of the cell's Font property is returned. If OfText is False
    ' or omitted, the ColorIndex of the cell's Interior property
    ' is returned.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    Dim Arr() As Long
    Dim NumRows As Long
    Dim NumCols As Long
    Dim RowNdx As Long
    Dim ColNdx As Long
    Dim CI As Long
    Dim Trans As Boolean
    
    Application.Volatile True
    If InRange Is Nothing Then
        ColorIndexOfRange = CVErr(xlErrRef)
        Exit Function
    End If
    If InRange.Areas.Count > 1 Then
        ColorIndexOfRange = CVErr(xlErrRef)
        Exit Function
    End If
    If (DefaultColorIndex < -1) Or (DefaultColorIndex > 56) Then
        ColorIndexOfRange = CVErr(xlErrValue)
        Exit Function
    End If
    
    NumRows = InRange.Rows.Count
    NumCols = InRange.Columns.Count
    
    If (NumRows > 1) And (NumCols > 1) Then
        ReDim Arr(1 To NumRows, 1 To NumCols)
        For RowNdx = 1 To NumRows
            For ColNdx = 1 To NumCols
                CI = ColorIndexOfOneCell(Cell:=InRange(RowNdx, ColNdx), _
                    OfText:=OfText, DefaultColorIndex:=DefaultColorIndex)
                Arr(RowNdx, ColNdx) = CI
            Next ColNdx
        Next RowNdx
        Trans = False
    ElseIf NumRows > 1 Then
        ReDim Arr(1 To NumRows)
        For RowNdx = 1 To NumRows
            CI = ColorIndexOfOneCell(Cell:=InRange.Cells(RowNdx, 1), _
                OfText:=OfText, DefaultColorIndex:=DefaultColorIndex)
            Arr(RowNdx) = CI
        Next RowNdx
        Trans = True
    Else
        ReDim Arr(1 To NumCols)
        For ColNdx = 1 To NumCols
            CI = ColorIndexOfOneCell(Cell:=InRange.Cells(1, ColNdx), _
                OfText:=OfText, DefaultColorIndex:=DefaultColorIndex)
            Arr(ColNdx) = CI
        Next ColNdx
        Trans = False
    End If

    If IsObject(Application.Caller) = False Then
        Trans = False
    End If
    
    If Trans = False Then
        ColorIndexOfRange = Arr
    Else
        ColorIndexOfRange = Application.Transpose(Arr)
    End If
    
    End Function

می‌توانید از تابع ColorIndexOfRange در کدهای دیگر استفاده کنید، مانند:

Sub AAA()
        Dim V As Variant
        Dim N As Long
        Dim RR As Range
        Set RR = Range("ColorCells")
        V = ColorIndexOfRange(InRange:=RR, OfText:=False, DefaultColorIndex:=1)
        If IsError(V) = True Then
            Debug.Print "*** ERROR: " & CStr(V)
            Exit Sub
        End If
        If IsArray(V) = True Then
            For N = LBound(V) To UBound(V)
                Debug.Print RR(N).Address, V(N)
            Next N
        End If
    End Sub

تغییر رنگ و محاسبه

اکسل معمولاً زمانی که سلولی که فرمول به آن بستگی دارد تغییر می کند، فرمول را در یک سلول محاسبه می کند. به عنوان مثال، فرمول =SUM(A1:A10) هنگامی که هر سلول در A1:A10 تغییر می کند، دوباره محاسبه می شود. با این حال، اکسل تغییر رنگ سلول را برای محاسبه مهم در نظر نمی گیرد و بنابراین لزوماً هنگام تغییر رنگ سلول، فرمول را دوباره محاسبه نمی کند. در ادامه این صفحه، تابعی به نام CountColor را مشاهده خواهیم کرد که تعداد سلول های یک محدوده را که دارای شاخص رنگ خاصی هستند، می شمارد. اگر رنگ سلولی را در محدوده ای که به CountColor ارسال می شود تغییر دهید، اکسل تابع CountColor را مجدداً محاسبه نمی کند و بنابراین، نتیجه CountColor ممکن است تا زمانی که محاسبه مجدد انجام نشود، با رنگ های واقعی در کاربرگ مطابقت نداشته باشد. توابع مربوطه از Application.Volatile True برای وادار کردن آنها به محاسبه مجدد در هنگام انجام هر گونه محاسبه استفاده می کنند، اما این هنوز کافی نیست. تغییر ساده رنگ سلول باعث محاسبه نمی شود، بنابراین تابع حتی با Application.Volatile True دوباره محاسبه نمی شود.

شبیه سازی یک رویداد تغییر رنگ

در حالی که اکسل هیچ رویدادی برای تغییر رنگ سلول ارائه نمی دهد، می توانید از رویداد Worksheet_Change برای تشخیص اینکه آیا کاربر وارد محدوده ColorCells شده و آیا کاربر از محدوده ColorCells خارج می شود یا خیر استفاده کنید.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Static OldCell As Excel.Range
        If OldCell Is Nothing Then
            Set OldCell = ActiveCell
        End If
        ' movement within ColorCells:
        If Not Application.Intersect(Target(1, 1), Range("ColorCells")) Is Nothing Then
            Me.Calculate
        ' movement out
        ElseIf Application.Intersect(Target(1, 1), Range("ColorCells")) Is Nothing Then
            If Not Application.Intersect(OldCell, Range("ColorCells")) Is Nothing Then
                Me.Calculate
            End If
        End If
        Set OldCell = Target(1, 1)
    End Sub

این کد آزمایش می کند که آیا کاربر انتخاب را از یک سلول در ColorCells به سلول دیگر در ColorCells تغییر داده است یا خیر، و کاربرگ را دوباره محاسبه می کند. این کد همچنین آزمایش می کند که آیا کاربر انتخاب را از سلولی در ColorCells به سلولی خارج از ColorCells منتقل می کند یا خیر. اگر این درست باشد، کاربرگ محاسبه می شود. تا زمانی که مایکروسافت سیستم رویداد خود را ارتقاء ندهد، این کد نزدیک است. در لحظه ای که رنگ تغییر می کند محاسبه می کند، اما به محض اینکه کاربر سلولی را در ColorCells انتخاب کند یا از محدوده ColorCells خارج شود، محاسبه می شود.

انجام عملیات با مقادیر شاخص رنگ

توانایی برگرداندن آرایه‌ای از نمایه‌های رنگی به ما اجازه می‌دهد تا شاخص‌های رنگی محدوده سلول‌ها را آزمایش کنیم و بر اساس مقایسه آن مقادیر با یک مقدار شاخص رنگ خاص، عملیات انجام دهیم. به عنوان مثال، می‌توانیم از تابع ColorIndexOfRange در یک فرمول برای شمارش تعداد سلول‌هایی که رنگ پرشان قرمز است استفاده کنیم.

=SUMPRODUCT(--(COLORINDEXOFRANGE(B11:B17,FALSE,1)=3))

این تابع تعداد سلول هایی را در محدوده B11:B17 که شاخص رنگ آنها 3 یا قرمز است را برمی گرداند. به جای کدنویسی سخت 3 در فرمول، می توانید شاخص رنگ سلول دیگری را با تابع ColorIndexOfOneCell دریافت کنید و آن مقدار را به تابع ColorIndexOfRange منتقل کنید. به عنوان مثال، برای شمارش سلول‌های B11:B17 که دارای شاخص رنگی برابر با شاخص رنگ سلول H7 هستند، از فرمول استفاده می‌کنیم:

=SUMPRODUCT(--(COLORINDEXOFRANGE(B11:B17,FALSE,1)=COLORINDEXOFONECELL(H7,FALSE,1)))

برای شمارش رنگ‌ها، ماژول قابل دانلود modColorFunctions یک تابع مستقیم به نام CountColor ارائه می‌کند که تعداد سلول‌های یک محدوده را که دارای شاخص رنگ (از Font یا Interior) برابر با مقدار مشخصی هستند، می‌شمارد.

تابع CountColor در زیر نشان داده شده است:

Function CountColor(InRange As Range, ColorIndex As Long, _
    Optional OfText As Boolean = False) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CountColor
' This function counts the cells in InRange whose ColorIndex
' is equal to the ColorIndex parameter. The ColorIndex of the
' Font is tested if OfText is True, or the Interior property
' if OfText is omitted or False. If ColorIndex is not a valid
' ColorIndex (1 -> 56, xlColorIndexNone, xlColorIndexAutomatic)
' 0 is returned. If ColorIndex is 0, then xlColorIndexNone is
' used if OfText is Fasle or xlColorIndexAutomatic if OfText
' is True. This allows the caller to use a value of 0 to indicate
' no color for either the Interior or the Font.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Range
Dim N As Long
Dim CI As Long

If ColorIndex = 0 Then
    If OfText = False Then
        CI = xlColorIndexNone
    Else
        CI = xlColorIndexAutomatic
    End If
Else
    CI = ColorIndex
End If


Application.Volatile True
Select Case ColorIndex
    Case 0, xlColorIndexNone, xlColorIndexAutomatic
        ' OK
    Case Else
        If IsValidColorIndex(ColorIndex) = False Then
            CountColor = 0
            Exit Function
        End If
End Select

For Each R In InRange.Cells
    If OfText = True Then
        If R.Font.ColorIndex = CI Then
            N = N + 1
        End If
    Else
        If R.Interior.ColorIndex = CI Then
            N = N + 1
        End If
    End If
Next R

CountColor = N

End Function

می توانید تابع CountColor را در فرمول کاربرگ مانند شکل زیر فراخوانی کنید. با این کار تعداد گلبول های قرمز در محدوده A1:A10 محاسبه می شود.

=COUNTCOLOR(A1:A10,3,FALSE)

می‌توانیم از تابع ColorIndexOfRange برای بدست آوردن مجموع مقادیر در سلول‌هایی استفاده کنیم که شاخص رنگ آنها مقداری مشخص است. برای مثال، فرمول آرایه زیر مقادیر سلول‌های محدوده B11:B17 را که رنگ پر شدن آن قرمز است، جمع می‌کند.

=SUM(B11:B17*(COLORINDEXOFRANGE(B11:B17,FALSE,1)=3))

مانند شمارش رنگ ها، جمع کردن مقادیر بر اساس یک رنگ یک کار رایج است و ماژول modColorFunctions تابعی را برای انجام مستقیم این کار ارائه می دهد. تابع SumColor در زیر نشان داده شده است:

Function SumColor(TestRange As Range, SumRange As Range, _
    ColorIndex As Long, Optional OfText As Boolean = False) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SumColor
' This function returns the sum of the values in SumRange where
' the corresponding cell in TestRange has a ColorIndex (of the
' Font is OfText is True, or of the Interior is OfText is omitted
' or False) equal to the specified ColorIndex. TestRange and
' SumRange may refer to the same range. An xlErrRef (#REF) error
' is returned if either TestRange or SumRange has more than one
' area or if TestRange and SumRange have differing number of
' either rows or columns. An xlErrValue (#VALUE) error is
' returned if ColorIndex is not a valid ColorIndex value.
' If ColorIndex is 0, xlColorIndexNone is used if OfText is
' False or xlColorIndexAutomatic if OfText is True. This allows
' the caller to specify 0 for no color applied.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim D As Double
Dim N As Long
Dim CI As Long

Application.Volatile True
If (TestRange.Areas.Count > 1) Or _
    (SumRange.Areas.Count > 1) Or _
    (TestRange.Rows.Count <> SumRange.Rows.Count) Or _
    (TestRange.Columns.Count <> SumRange.Columns.Count) Then
    SumColor = CVErr(xlErrRef)
    Exit Function
End If
    
If ColorIndex = 0 Then
    If OfText = False Then
        CI = xlColorIndexNone
    Else
        CI = xlColorIndexAutomatic
    End If
Else
    CI = ColorIndex
End If

Select Case CI
    Case 0, xlColorIndexAutomatic, xlColorIndexNone
        ' ok
    Case Else
        If IsValidColorIndex(ColorIndex:=ColorIndex) = False Then
            SumColor = CVErr(xlErrValue)
            Exit Function
        End If
End Select

For N = 1 To TestRange.Cells.Count
    With TestRange.Cells(N)
    If OfText = True Then
        If .Font.ColorIndex = CI Then
            If IsNumeric(SumRange.Cells(N).Value) = True Then
                D = D + SumRange.Cells(N).Value
            End If
        End If
    Else
        If .Interior.ColorIndex = CI Then
            If IsNumeric(SumRange.Cells(N).Value) = True Then
                D = D + SumRange.Cells(N).Value
            End If
        End If
    End If
    End With
Next N
            
SumColor = D

End Function

تابع SumColor یک آنالوگ مبتنی بر رنگ از هر دو تابع SUM و SUMIF است. این به شما امکان می‌دهد محدوده‌های جداگانه‌ای را برای محدوده‌ای که شاخص‌های رنگ آن بررسی می‌شود و محدوده سلول‌هایی که مقادیر آن‌ها باید جمع شوند، مشخص کنید. اگر این دو محدوده یکسان باشند، تابع سلول هایی را که رنگ آنها با مقدار مشخص شده مطابقت دارد، جمع می کند. به عنوان مثال، فرمول زیر مقادیر B11:B17 که رنگ پر شدن آن قرمز است را جمع می کند.

=SUMCOLOR(B11:B17,B11:B17,3,FALSE)

در این فرمول، محدوده B11:B17 هم محدوده مورد آزمایش و هم محدوده برای جمع است. این محدوده ها ممکن است متفاوت باشند. به عنوان مثال، فرمول زیر شاخص رنگ سلول ها را در B11:B17 بررسی می کند و اگر شاخص رنگ آن سلول 3 باشد، مقدار مربوطه را از D11:D17 جمع می کند.

=SUMCOLOR(B11:B17,D11:D17,3,FALSE)

از آنجایی که تابع ColorIndexOfRange آرایه ای از مقادیر را برمی گرداند، می توان از آن در هر فرمول آرایه ای استفاده کرد. برای مثال، فرمول زیر حداقل مقداری را که رنگ پر شدن آن قرمز است از محدوده B11:B17 برمی‌گرداند:

=MIN(IF(COLORINDEXOFRANGE(B11:B17,FALSE,1)=3,B11:B17,FALSE))

یافتن رنگ ها

ماژول قابل دانلود حاوی تابعی به نام RangeOfColor است که یک شی Range متشکل از سلول های یک محدوده ورودی که دارای فونت یا شاخص رنگ پر برابر با شاخص رنگ مشخص شده است را برمی گرداند. اعلان تابع عبارت است از:

Function RangeOfColor(TestRange As Range, _
        ColorIndex As Long, Optional OfText As Boolean = False) As Range

می توانید از این تابع برای بدست آوردن محدوده ای از سلول ها با رنگ پر قرمز استفاده کنید. مثلا،

Sub AAA()
        Dim R As Range
        Dim RR As Range
        Set RR = RangeOfColor(TestRange:=Range("A1:F20"), _
                ColorIndex:=3, OfText:=False)
        If Not RR Is Nothing Then
            For Each R In RR
                Debug.Print R.Address
            Next R
        Else
            Debug.Print "*** NO CELLS FOUND"
        End If
    End Sub

با این کار در پنجره VBA Immediate آدرس سلول هایی در محدوده A1:F20 که دارای رنگ پر قرمز هستند چاپ می شود.

توابع برای پالت و نام رنگ

ماژول modColorFunctions شامل توابع مربوط به پالت رنگ و نام رنگ است.

پالت رنگی پیش فرض
این تابع آرایه ای را برمی گرداند که پالت رنگی پیش فرض اکسل است. این آرایه تغییراتی را که در Workbook.Colors ایجاد شده است منعکس نمی کند. اگر مقدار Option Base ماژول حاوی تابع DefaultColorpalette (نه ماژولی که از آن فراخوانی می شود) Option Base 0 باشد، آرایه نتیجه دارای 57 عنصر (0 تا 56) و عنصر 0 دارای مقدار 1- است. اگر مقدار Option Base Option Base 1 باشد، آرایه نتیجه دارای 56 عنصر (1 تا 56) است. در هر صورت، می توانید از یک مقدار ColorIndex معتبر برای برگرداندن مقدار رنگ RGB استفاده کنید:

Dim N As Long
    N = 3
    Debug.Print N, Hex(DefaultColorpalette(N))

DefaultColorNames
این تابع آرایه‌ای از نام‌های انگلیسی آمریکایی رنگ‌ها را در پالت پیش‌فرض برمی‌گرداند (نه پالتی که با Workbook.Colors اصلاح شده است. این نام‌های رنگ‌هایی هستند که در عناصر متن نکته ابزار نوار فرمان رنگی اکسل ظاهر می‌شوند. اگر گزینه مقدار پایه ماژول حاوی تابع DefaultColorNames (نه ماژولی که از آن فراخوانی می شود) Option Base 0 است، آرایه نتیجه دارای 57 عنصر (0 تا 56) و عنصر 0 دارای مقدار UNNAMED است. اگر مقدار Option Base باشد. گزینه پایه 1 است، آرایه نتیجه دارای 56 عنصر است (1 تا 56). در هر صورت، می توانید از یک مقدار ColorIndex معتبر برای برگرداندن نام رنگ استفاده کنید. همه رنگ ها نام ندارند -- آنهایی که ندارند در نشان داده می شوند. آرایه به عنوان رشته UNNAMED.

Dim N As Long
    N = 3
    Debug.Print N, DefaultColorNames(N)

ColorNameOfRGB
اگر آن رنگ در پالت پیش‌فرض برنامه وجود داشته باشد، نام رنگ انگلیسی ایالات متحده مربوط به رنگ RGB مشخص شده را برمی‌گرداند. اگر رنگ در پالت یافت نشد، تابع vbNullString را برمی‌گرداند

توابع برای مقادیر رنگ

ماژول modColorFunctions شامل تعدادی عملکرد برای کار با رنگ های RGB و مقادیر شاخص رنگ است.

ColorIndexOfRGBLong
اگر در پالت فعلی وجود داشته باشد، این مقدار Color Index مقدار رنگ مشخص شده RGB Long را برمی گرداند. در غیر این صورت 0 را برمی گرداند.

IsColorpaletteDefault
اگر پالت مرتبط با کتاب کار مشخص شده، پالت پیش‌فرض برنامه باشد، مقدار True را برمی‌گرداند. اگر پالت با Workbook.Colors اصلاح شده باشد، False را برمی گرداند.

IsColorIndexDefault
اگر رنگ مرتبط با شاخص رنگ مشخص شده با مقدار شاخص رنگ پیش‌فرض برنامه یکسان باشد، مقدار True را برمی‌گرداند. این به شما می گوید که آیا رنگ مرتبط با یک مقدار شاخص رنگ تغییر کرده است یا خیر.

RGBComponentsFromRGBLongToVariables
این یک مقدار RGB Long را به مقادیر تشکیل دهنده قرمز، سبز و آبی تقسیم می کند که در متغیرهای ByRef به تماس گیرنده برگردانده می شود. اگر مقدار ورودی یک رنگ RGB معتبر بود، نتیجه تابع True یا اگر مقدار ورودی یک رنگ RGB معتبر نبود، نادرست است. مثلا،

Dim RGBColor As Long
    Dim Red As Long
    Dim Green As Long
    Dim Blue As Long
    Dim B As Boolean
    
    RGBColor = ActiveCell.Interior.Color
    B = RGBComponentsFromRGBLongToVariables(RGBColor, Red, Green, Blue)
    If B = True Then
        Debug.Print "Red: " & Red, "Green: " & Green, "Blue: " & Blue
    Else
        Debug.Print "Invalid value in RGBColor"
    End If

RGB ComponentsFromRGBLong
این یک مقدار رنگ RGB Long را به اجزای قرمز، سبز و آبی تقسیم می کند و آنها را به عنوان آرایه ای از Longs برمی گرداند

Arr(1) = Red
    Arr(2) = Green
    Arr(3) = Blue

نمایش دیالوگ انتخابگر رنگ

ماژول modColorFunctions حاوی تابعی به نام ChooseColorDialog است که یک گفتگوی انتخابگر رنگ ویندوز را نمایش می دهد و مقدار رنگ RGB Long را برمی گرداند. اگر کاربر گفتگو را لغو کند، نتیجه -1 است. مثلا،

Dim RGBColor As Long
    Dim Default As Long
    Default = RGB(255, 0, 255) 'default to purple
    RGBColor = ChooseColorDialog(DefaultColor:=Default)
    If RGBColor < 0 Then
        Debug.Print "*** USER CANCELLED"
    Else
        Debug.Print "Choice: " & Hex(RGBColor)
    End If

تعیین نزدیکترین رنگ در پالت

در این بخش، از یک تابع VBA برای برگرداندن مقدار ColorIndex رنگ در پالتی که نزدیک‌ترین مقدار رنگ RGB Long است، استفاده می‌کنیم. کل مفهوم "نزدیک ترین" رنگ تا حدودی ذهنی است. دو نفر نیازی به توافق ندارند که آیا یک رنگ در واقع به رنگی نزدیکتر از رنگ دیگر است. روش مورد استفاده در اینجا هر رنگ RGB را به عنوان یک مکان فضایی در یک فضای 3 بعدی در نظر می گیرد که در آن محورها اجزای قرمز، سبز و آبی با مقدار RGB Long هستند. کد، ColorIndex رنگی را پیدا می کند که کمترین فاصله را در این فاصله بین مقدار Colors (ColorIndex) و مقدار RGB Long برای آزمایش دارد. فاصله با فاصله فیثاغورثی ساده تعیین می شود، اما برای سرعت محاسبه، جذر را از محاسبه حذف می کنیم.

Function ClosestColor(RGBLong As Long) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ClosestColor
' This function returns ColorIndex of the color that is "closest" to the
' specified RGBLong value. "Closest" is taken in the geometrical sense, the
' distance between two colors in a 3-dimensional space with axes of Red,
' Green, and Blue values. That is, a color is identified spatially by
' the values of the Red, Green, and Blue components. The distances between
' the spatial location of RGBLong and each Color of the palette is computed
' and the ColorIndex that minimizes this distance is returned. The distance
' between RGBLong and each Colors(ColorIndex) value is computed by simple
' Pythagorean distance:
'       Dist = ( (R1-R2)^2  + (G1-G2)^2 + (B1-B2)^2 ) ^ (1/2)
' where R1, G1, and B1 are the compontents of RGBLong and R2, G2, and B2 are
' the components of each Color(ColorIndex) value.
' We can save some processing by omitting the square root from the calculations.
' Note that the entire concept of a "closest" color is rather subjective and there
' are other methods of computing the "closeness" of two colors.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim MinDist As Double   ' running minimum distance 
Dim MinCI As Double     ' ColorIndex corresponding to MinDist 
Dim CI As Long          ' ColorIndex loop variable 
Dim DistCI As Double    ' Distance between each CI and RGBLong 


' values from RGBLong 
Dim RedTest As Long
Dim GreenTest As Long
Dim BlueTest As Long

' value from each CI in palette 
Dim RedCI As Long
Dim GreenCI As Long
Dim BlueCI As Long

' ensure we have a valid RGB 
If IsValidRGBLong(RGBLong) = False Then
    ClosestColor = 0
    Exit Function
End If

' init min distance = maximum possible distance. 
MinDist = 195075 ' 255^2 + 255^2 + 255^2. omit the square root.

' color components of RGBLong 
RGBComponentsFromRGBLongToVariables RGBLong, RedTest, GreenTest, BlueTest

For CI = 1 To 56
    RGBComponentsFromRGBLongToVariables ThisWorkbook.Colors(CI), RedCI, GreenCI, BlueCI
    ' compute the distance. we omit the square root operations since it doesn't affect relationships. 
    DistCI = ((RedTest - RedCI) ^ 2 + (GreenTest - GreenCI) ^ 2 + (BlueTest - BlueCI) ^ 2)
    If DistCI < MinDist Then
        ' distance is less than current minimum. set save variables. 
        MinDist = DistCI
        MinCI = CI
    End If
Next CI

ClosestColor = MinCI

End Function