Home > front end >  Coding a macro for MSWord auto formatting - help request
Coding a macro for MSWord auto formatting - help request

Time:11-25

I have a macro that I was given by a predecessor, but would like to add automatic colouring of the font to it as well (white on dark colours, black on light colours). I have no experience with visual basic so any help appreciated.

Sub colourProgress()
    Dim c As Word.Cell
    If Selection.Information(wdWithInTable) Then
        For Each c In Selection.Tables(1).Range.Cells
          If IsNumeric(Left(c.Range.Text, Len(c.Range.Text) - 1)) Then
                If Val(c.Range.Text) = 3 Then
                    c.Shading.BackgroundPatternColor = wdColorYellow
                ElseIf Val(c.Range.Text) = 4 Then
                    c.Shading.BackgroundPatternColor = wdColorOrange
                End If
          ElseIf InStr(LCase(c.Range.Text), "good") > 0 Then
                c.Shading.BackgroundPatternColor = RGB(0, 176, 80)
        ElseIf InStr(LCase(c.Range.Text), "exceptional") > 0 Then
                c.Shading.BackgroundPatternColor = RGB(148, 55, 257)
        ElseIf InStr(LCase(c.Range.Text), "satisfactory") > 0 Then
                c.Shading.BackgroundPatternColor = wdColorYellow
        ElseIf InStr(LCase(c.Range.Text), "serious") > 0 Then
                c.Shading.BackgroundPatternColor = wdColorRed
        ElseIf InStr(LCase(c.Range.Text), "concern") > 0 Then
                c.Shading.BackgroundPatternColor = RGB(255, 192, 0)
        ElseIf InStr(LCase(c.Range.Text), "three or more sub-levels above target") > 0 Then
                c.Shading.BackgroundPatternColor = RGB(148, 55, 257)
         ElseIf InStr(LCase(c.Range.Text), "two sub-levels above target") > 0 Then
                c.Shading.BackgroundPatternColor = wdColorBrightGreen
        ElseIf InStr(LCase(c.Range.Text), "one sub-level above target") > 0 Then
                c.Shading.BackgroundPatternColor = RGB(0, 176, 80)
        ElseIf InStr(LCase(c.Range.Text), "on target") > 0 Then
                c.Shading.BackgroundPatternColor = wdColorYellow
        ElseIf InStr(LCase(c.Range.Text), "one sub-level below target") > 0 Then
                c.Shading.BackgroundPatternColor = RGB(255, 192, 0)
        ElseIf InStr(LCase(c.Range.Text), "two or more sub-levels below target") > 0 Then
                c.Shading.BackgroundPatternColor = wdColorRed
                
          ElseIf c.RowIndex > 1 Then ' set non-numeric in row 2 and down to White
                c.Shading.BackgroundPatternColor = wdColorWhite
          End If
        Next c
    End If
End Sub

I tried adding this c.Font.Color = white but it doesn't work.

CodePudding user response:

When you type an object name followed by a period in the VBA editor IntelliSense will show you a list of valid options to follow the period:

enter image description here

Font would not have been in that list. However, you can see from the code you already have that an object called Range has a text property. If Range has text, you can logically conclude that it must also have a Font property.

enter image description here

To set the font colour to automatic you would need something like:

c.Range.Font.ColorIndex = wdAuto

However, rather than set the text color for individual cells you would be better to set the color for the entire table. If your document is formatted correctly there should be no need to use code to change the font color, otherwise it can be done with code like this:

Selection.Tables(1).Range.Font.ColorIndex = wdAuto

CodePudding user response:

You need to use the property like this : c.Font.Color = RGB(120, 120, 0)

You can eventually store the color you want in a variable. This page will help you set the colors you want for the font.

The property TintAndShade will let you set how dark or light the color will be, it accepts values from -1 (darkest) to 1 (lightest), see here

Here is an example code:

Sub setColorAndShade()

    Dim cell As Range
    Dim colorRed As Long
    Dim colorGreen As Long
    Dim colorBlue As Long
    
    Set cell = ActiveSheet.Cells(1, 1)
    colorRed = RGB(255, 0, 0)
    colorGreen = RGB(0, 255, 0)
    colorBlue = RGB(0, 0, 255)
    
    With cell.Font
        .Color = colorRed
        .TintAndShade = -1
    End With
    
    With cell.Offset(1, 0).Font
        .Color = colorGreen
        .TintAndShade = 0
    End With
    
    With cell.Offset(2, 0).Font
        .Color = colorBlue
        .TintAndShade = 1
    End With
    
End Sub

If you need additional help don't hesitate to write what you need as an update to your question or in the comments.

  • Related