DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub GetCellColorName()
Dim i As Integer
For i = 1 To 8
Cells(i, "E") = GetColorName(Range("C" & i).Interior.Color)
Next i
End Sub
Function GetColorName(ByVal colorCode As Long) As String
Dim colorName As String
Select Case colorCode
Case RGB(0, 0, 0)
colorName = "Siyah"
Case RGB(0, 0, 255)
colorName = "Mavi"
Case RGB(0, 255, 0)
colorName = "Yeşil"
Case RGB(0, 255, 255)
colorName = "Mavi-Yeşil"
Case RGB(255, 0, 0)
colorName = "Kırmızı"
Case RGB(255, 0, 255)
colorName = "Magenta"
Case RGB(255, 255, 0)
colorName = "Sarı"
Case RGB(255, 255, 255)
colorName = "Beyaz"
Case RGB(128, 0, 0)
colorName = "Kahverengi"
'Diğer Renkleri Tanımlayın
Case Else
colorName = "Bilinmiyor, Tanımlayınız"
End Select
GetColorName = colorName
End Function
Teşekkür ederim hocam selamlarMerhaba,
Deneyiniz.
Kod:Sub GetCellColorName() Dim i As Integer For i = 1 To 8 Cells(i, "E") = GetColorName(Range("C" & i).Interior.Color) Next i End Sub Function GetColorName(ByVal colorCode As Long) As String Dim colorName As String Select Case colorCode Case RGB(0, 0, 0) colorName = "Siyah" Case RGB(0, 0, 255) colorName = "Mavi" Case RGB(0, 255, 0) colorName = "Yeşil" Case RGB(0, 255, 255) colorName = "Mavi-Yeşil" Case RGB(255, 0, 0) colorName = "Kırmızı" Case RGB(255, 0, 255) colorName = "Magenta" Case RGB(255, 255, 0) colorName = "Sarı" Case RGB(255, 255, 255) colorName = "Beyaz" Case RGB(128, 0, 0) colorName = "Kahverengi" 'Diğer Renkleri Tanımlayın Case Else colorName = "Bilinmiyor, Tanımlayınız" End Select GetColorName = colorName End Function