56 Sắc cầu vòng trong excel (phần 1)

 56 Sắc cầu vòng trong excel (phần 1)

I. Hàm trả về chỉ số màu & ColorName của ô màu được chỉ định:

Code:

Function O_Mau(rCell As Range, Optional TenColor As Boolean)
Dim StrMau As String, iChiSo As Integer

iChiSo = rCell.Interior.ColorIndex
Select Case iChiSo
   Case 1
    StrMau = "Black"
   Case 2:                  StrMau = "White"
   Case 3:                  StrMau = "Red"
   Case 4:                  StrMau = "Bright Green"
   Case 5:                  StrMau = "Blue"
   Case 6:                  StrMau = "Yellow"
   Case 7:                  StrMau = "Pink"
   Case 8:                  StrMau = "Turqoise"
   Case 9:                  StrMau = "Dark Red"
   Case 10:                 StrMau = "Green"
   Case 11:                 StrMau = "Dark Blue"
   Case 12:                 StrMau = "Dark Yellow"
   Case 13:                 StrMau = "Violet"
   Case 14:                 StrMau = "Teal"
   Case 15:                 StrMau = "Gray-25%"
   Case 16:                 StrMau = "Gray-50%"
   
   Case 33:                 StrMau = "Sky Blue"
   Case 34:                 StrMau = "Light Turqoise"
   Case 35:                 StrMau = "Light Green"
   Case 36:                 StrMau = "Light Yellow"
   Case 37:                 StrMau = "Pale Blue"
   Case 38:                 StrMau = "Rose"
   Case 39:                 StrMau = "Lavendar"
   Case 40:                 StrMau = "Tan"
   Case 41:                 StrMau = "Light Blue"
   Case 42:                 StrMau = "Aqua"
   Case 43:                 StrMau = "Lime"
   Case 44:                 StrMau = "Gold"
   Case 45:                 StrMau = "Light Orange"
   Case 46:                 StrMau = "Orange"
   Case 47:                 StrMau = "Blue-Gray"
   Case 48:                 StrMau = "Gray-40%"
   Case 49:                 StrMau = "Dark Teal"
   Case 50:                 StrMau = "Sea Green"
   Case 51:                 StrMau = "Dark Green"
   Case 52:                 StrMau = "Olive Green"
   Case 53:                 StrMau = "Brown"
   Case 54:                 StrMau = "Plum"
   Case 55:                 StrMau = "Indigo"
   Case 56:                 StrMau = "Gray-80%"
  Case Else:                StrMau = "Custom color or no fill"
 End Select

 O_Mau = iChiSo & "- " & StrMau
 If TenColor = True Or StrMau = "Custom color or no fill" Then O_Mau = StrMau
End Function

II. Đoạn mã tô màu trắng giá trị chứa trong các ô có màu nền là 41 "Light Blue":

Code:

Sub whiteONblue()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual   'pre XL97 xlManua
  Dim cell As Range
  '---Range("A3:N100").Select 
 For Each cell In Selection
    If cell.Interior.colorindex = 41 And cell.Column = 4 Then
        cell.Font.colorindex = 2  '2=white, 6=yellow
    End If
  Next cell
  Application.Calculation = xlCalculationAutomatic   'pre XL97 xlManua
  Application.ScreenUpdating = False
End Sub

III. Đoạn mã sau đây sẽ xóa giá trị trong các ô đã được tô màu trong vùng chọn:

Code:

Sub XoaConstantsTuOMau()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim Cell As Range
   On Error Resume Next   'In case no cells in selection
   Application.EnableEvents = False
   For Each Cell In Intersect(Selection, Cells.SpecialCells(xlConstants))
      If Cell.Interior.ColorIndex >= 0 Then Cell.ClearContents
   Next
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub

IV. Đoạn mã sau đây sẽ tô màu các hàng trong vùng chọn theo giá trị cột đầu trong vùng:

Code:

Sub ColorRowBasedOnCellValue()
  'David_McRitchie, 20010117
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Dim cell As Range
  For Each cell In Intersect(Selection, ActiveCell.EntireColumn, _
         ActiveSheet.UsedRange)
    Select Case cell.Value
        Case Is >= 50
            cell.EntireRow.Interior.ColorIndex = 20
        Case Is >= 40
            cell.EntireRow.Interior.ColorIndex = 37
        Case Is >= 20
            cell.EntireRow.Interior.ColorIndex = 38
        Case Is >= 0
            cell.EntireRow.Interior.ColorIndex = 36
        Case Else
            cell.EntireRow.Interior.ColorIndex = 44
    End Select
  Next cell
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = False
End Sub

V. Đoạn mã sau đây sẽ tô màu nền các ô chứa công thức trong vùng chọn theo màu nền của ô mà công thức tham chiếu đến:

Code:

Sub ColorOfAssignment()
    Dim rnG As Range, celL As Range
    Set rnG = Selection
    'rng.Interior.ColorIndex = xlAutomatic   'clear color
    For Each celL In Intersect(rnG, rnG.SpecialCells(xlFormulas))
        On Error Resume Next
        celL.Interior.ColorIndex = Range(Mid(celL.Formula, 2)).Interior.ColorIndex
        On Error GoTo 0
    Next celL
End Sub