Tô mầu cho từng ký tự trong Cells

[boyxin]

Chào các bác.

Em muốn tô màu cho từng ký tự trong cells thì phải dùng code như thế nào?

Em cố tình dùng bộ thu macro nhưng không thu được​

 

[hoangdanh282vn]

Chào các bác.

Em muốn tô màu cho từng ký tự trong cells thì phải dùng code như thế nào?

Em cố tình dùng bộ thu macro nhưng không thu được​

Em dùng bộ thu, kết quả như sau : Chỉ cần bỏ bớt những code không cần thiết và thêm for vào là ok.

Range("C2").Select
    ActiveCell.FormulaR1C1 = "danh"
    With ActiveCell.Characters(Start:=1, Length:=1).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=2, Length:=1).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399975585192419
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=3, Length:=1).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=4, Length:=1).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -11489280
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With

 

[tigertiger]

Em dùng bộ thu, kết quả như sau : Chỉ cần bỏ bớt những code không cần thiết và thêm for vào là ok.

Tuy nhiên nó lại không thực thi được
bị lỗi Object?
????

 

[boyxin]

Cảm ơn Danh nhé

​

Các bác test thử đoạn này xem thế nào?
​

Sub tomau_kytu()
Set Rng = [a1].CurrentRegion
For Each clls In Rng
    For i = 1 To Len(clls.Value)
        With clls.Characters(Start:=i, Length:=1).Font
            .ColorIndex = i
        End With
    Next
Next
End Sub

 

[rollover79]

Yêu cầu này tôi đã có 1 file ví dụ ở đây, bài số 3.
http://www.giaiphapexcel.com/forum/showthread.php?t=14538

Post xong mới đọc được bài của boyxin. Nhưng cũng xin chú ý 1 chút là nếu dùng ColorIndex thì chỉ được phép nhận giá trị từ 0 đến 56 thôi. Nên thay vì gán ColorIndex = i thì hãy gán là ColorIndex = i mode 57

 

[hoangdanh282vn]

Cảm ơn Danh nhé

​

Các bác test thử đoạn này xem thế nào?
​

Sub tomau_kytu()
Set Rng = [a1].CurrentRegion
For Each clls In Rng
    For i = 1 To Len(clls.Value)
        With clls.Characters(Start:=i, Length:=1).Font
            .ColorIndex = i
        End With
    Next
Next
End Sub

ColorIndex có giá trị < 57
Phải cận thận với màu sắc và phiên bản của excel.
Nếu .ColorIndex = i mod 57 chắc ok.

 

[boyxin]

Sub tomau_kytu()
Set Rng = [a1].CurrentRegion
For Each clls In Rng
    j = j + 1
    For i = 1 To Len(clls.Value)
        With clls.Characters(Start:=i, Length:=1).Font
            .ColorIndex = (i + j) Mod 57
        End With
    Next
Next
End Sub

Vẫn còn 1 vấn đề chưa xử lý được:
khi nội dung trong cells là number thì code không tác dụng. Mong được các bác xem lại giúp

 

[hoangvuluan]

Có 2 giải pháp: hoặc chuyển số thành chữ rồi tô màu; hoặc bỏ qua các giá trị số và không tô màu. Ở đây dùng cách chuyển số thành chữ:

Sub tomau_kytu()
Set Rng = [a1].CurrentRegion
For Each clls In Rng
    j = j + 1
    With clls
    If IsNumeric(.Value) Then .Value = "'" & .Value
    For i = 1 To Len(.Value)
        With .Characters(Start:=i, Length:=1).Font
            .ColorIndex = (i + j) Mod 57
        End With
    Next
    End With
Next
End Sub

 

[rollover79]

Vẫn còn 1 vấn đề chưa xử lý được:
khi nội dung trong cells là number thì code không tác dụng. Mong được các bác xem lại giúp

boyxin thử làm thủ công với 1 cells là number xem có được không? Tôi nghĩ có lẽ phải làm thủ công được thì code mới làm được.

 

[Mr Okebab]

Sub tomau_kytu()
Set Rng = [a1].CurrentRegion
For Each clls In Rng
    j = j + 1
    For i = 1 To Len(clls.Value)
        With clls.Characters(Start:=i, Length:=1).Font
            .ColorIndex = (i + j) Mod 57
        End With
    Next
Next
End Sub

Vẫn còn 1 vấn đề chưa xử lý được:
khi nội dung trong cells là number thì code không tác dụng. Mong được các bác xem lại giúp

Excel không cho phép tô màu từng số khi giá trị trong Cell là số.
Thử bằng tay sẽ thấy ngay thôi mà.

Thân!