Color Letters

K

kmell

New Member
Joined
Aug 12, 2022
Messages
6
Office Version
  1. 2010
Platform
  1. Windows
como puedo simplificar esta macro para poner color diferente a cada letra
puede ser un color aletorio para cada letra

VBA Code: 
Sub colorear()
'
'
'

'
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "qwertyuiopasdfghjklñzxcvbnm"
    Range("A2").Select
    ActiveWindow.SmallScroll Down:=-21
    Range("A1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "qwertyuiopasdfghjklñzxcvbnm"
    With ActiveCell.Characters(Start:=1, Length:=0).Font
        .Name = "Arial Black"
        .FontStyle = "Normal"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=1, Length:=1).Font
        .Name = "Arial Black"
        .FontStyle = "Normal"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=2, Length:=1).Font
        .Name = "Arial Black"
        .FontStyle = "Normal"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16711681
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=3, Length:=1).Font
        .Name = "Arial Black"
        .FontStyle = "Normal"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=4, Length:=1).Font
        .Name = "Arial Black"
        .FontStyle = "Normal"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16711681
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=5, Length:=1).Font
        .Name = "Arial Black"
        .FontStyle = "Normal"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -4165632
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=6, Length:=1).Font
        .Name = "Arial Black"
        .FontStyle = "Normal"
        .Size = 20
        .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:=7, Length:=1).Font
        .Name = "Arial Black"
        .FontStyle = "Normal"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .ThemeFont = xlThemeFontNone
    End With
    With ActiveCell.Characters(Start:=8, Length:=20).Font
        .Name = "Arial Black"
        .FontStyle = "Normal"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("B1").Select
End Sub
 
Last edited by a moderator:

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
Welcome to the MrExcel board!

Please note few things about using the forum:
  1. Please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted. Please review the other rules while you are there. I have removed your duplicate question.
  2. Post your question in the correct forum. We have a dedicated forum for questions that are not in English. I have moved your post to that forum.
  3. When posting vba code use the available code tags. It makes your code much easier to read/debug. My signature block below has more details. I have added the tags for you this time.
  4. Give your thread a title that gives readers some idea of what your question is about. I have edited your thread title this time.
 
Upvote 0
consegui esto hasta ahora lo pueden mejorar para que sea mas corto y mas rapido

Sub palabra()
Dim cell As Range

With Range("A1")

For i = 1 To 56
Range("A1").Characters(i + 0, 1).Font.ColorIndex = i
Range("A1").Characters(i + 55, 1).Font.ColorIndex = i
Range("A1").Characters(i + 110, 1).Font.ColorIndex = i
Range("A1").Characters(i + 166, 1).Font.ColorIndex = i
Range("A1").Characters(i + 222, 1).Font.ColorIndex = i
Range("A1").Characters(i + 27, 1).Font.ColorIndex = i
Next i
End With
End Sub
 
Upvote 0
solo consigo 56 colores podria conseguir mas colores y que sean aleatorios

gracias
 
Upvote 0
Peter_SSs said:
When posting vba code use the available code tags. It makes your code much easier to read/debug. My signature block below has more details.
Google: Al publicar el código vba, use las etiquetas de código disponibles. Hace que su código sea mucho más fácil de leer/depurar. Mi bloque de firma a continuación tiene más detalles.
Click to expand...
 
Upvote 0
solo consigo 56 colores podria conseguir mas colores y que sean aleatorios
gracias
Click to expand...
Prueba esta variante
Code: 
 Sub colorear()
Dim Frase As String
Dim I As Long
'
Frase = "qwertyuiopasdfghjklñzxcvbnm"
    Range("A1").Formula = Frase
    With Range("A1")
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Font.Size = 20
        For I = 1 To Len(Frase)
            .Characters(Start:=I, Length:=1).Font.Color = _
               RGB(1 + Int(Rnd() * 255), 1 + Int(Rnd() * 255), 1 + Int(Rnd() * 255))
        Next I
    End With
End Sub
He insertado un bucle que cambia el color de cada carácter de la celda, eligiendo aleatoriamente una combinación RGB para cada uno de ellos

Recuerde usar las etiquetas para formatear correctamente las líneas de código.

(Traducido por translate.google.com)
 
Upvote 0
Anthony47 said:
Prueba esta variante
Code: 
 Sub colorear()
Dim Frase As String
Dim I As Long
'
Frase = "qwertyuiopasdfghjklñzxcvbnm"
    Range("A1").Formula = Frase
    With Range("A1")
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Font.Size = 20
        For I = 1 To Len(Frase)
            .Characters(Start:=I, Length:=1).Font.Color = _
               RGB(1 + Int(Rnd() * 255), 1 + Int(Rnd() * 255), 1 + Int(Rnd() * 255))
        Next I
    End With
End Sub
He insertado un bucle que cambia el color de cada carácter de la celda, eligiendo aleatoriamente una combinación RGB para cada uno de ellos

Recuerde usar las etiquetas para formatear correctamente las líneas de código.

(Traducido por translate.google.com)
Click to expand...
este que bien ya lo adapté
gracias
 
Upvote 0
kmell said:
este que bien ya lo adapté
gracias
Click to expand...
Este macro lo utilizo tres veces y en la cuarta ves ya no ejecuta las ordenes de colores el texto queda negro. Tengo que cerrar el documento y volverlo a abrir. Como lo soluciono. Por favor
 
Last edited by a moderator:
Upvote 0
Puedo ejecutar esa macro tantas veces como quiera sin ningún problema. ¿Qué ajustes has hecho? ¿Lo ha vinculado a algún "evento" de la hoja de trabajo?
 
Upvote 0
Anthony47 said:
Puedo ejecutar esa macro tantas veces como quiera sin ningún problema. ¿Qué ajustes has hecho? ¿Lo ha vinculado a algún "evento" de la hoja de trabajo?
Click to expand...
sale el error "no se pueden aplicar mas fuentes nuevas. cierre algunos documentos y vuelva a intentarlo" y se bloque excel
y tengo que cerrarlo.
no entiendo por que lo de la fuente
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Looping Through Workbook and making pivot tables on each worksheet
Replies
4
Views
321
rzacek87
R
F
  • Solved
Looping code sequence
Replies
5
Views
422
FrenchCelt
F
S
  • Question Question
vba logic to open up several files within a folder and perform 2-3 steps
Replies
1
Views
377
ranman256
ranman256
R
  • Question Question
VBA to add to data model when creating Power Query tables`
Replies
3
Views
577
Raddle
R
G
  • Solved
Does macro change font automatically when clsoing workbook and how do I get to do on mutiple sheets
Replies
3
Views
438
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,927
Messages
6,175,444
Members
452,642
Latest member
acarrigan

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top