Question

我想创建一个循环不同颜色的VBA代码。例如。当我第一次按ctrl + m时我想要它是蓝色，然后如果我按下相同的快捷键它会变成红色然后等其他颜色。如果我需要更改它们，也希望能够添加和取出颜色，这样如果有人可以解释他们的等式的颜色数组部分，这对我来说很适合自己进行编辑

Answer 1

尝试将 Ctrl + m 分配给此宏：

Sub CNTRLm()
    With ActiveCell.Font
        If .ColorIndex = 56 Then
           .ColorIndex = 1
        Else
        .ColorIndex = .ColorIndex + 1
        End If
    End With
End Sub

Answer 2

This website provides a chart of the basic 56 colors。搜索“调色板”＆＃39;如果需要，将帮助您找到其他人。数组从0开始，所以我建议以这种方式保持数组。使用我链接的图表，您可以根据需要为数组添加任意数量的颜色。只需确保更新ColorArray的数字序列，并将ReDim行更改为序列中的最后一个数字。

将以下代码分配给 Ctrl + m 并删除代码的背景或字体颜色部分。当您按 Ctrl + m 时选择的任何单元格都将更改为下一个数组颜色。但是，请确保选择颜色完全相同。这并没有考虑到多种颜色选择。

Sub SetColor()
    Dim ColorArray() As Long
    Dim ColorBg As Long
    Dim ColorFont As Long
    Dim counter As Long
    Dim changed As Boolean

    ReDim ColorArray(2)
    ColorArray(0) = 3       'Red
    ColorArray(1) = 4       'Green
    ColorArray(2) = 5       'Blue

'Use this if you want to change cell background color

    'Find background color to check against
    ColorBg = Selection.Interior.ColorIndex
    'Loop through array to find a match
    For counter = LBound(ColorArray) To UBound(ColorArray)
        If ColorBg = ColorArray(counter) Then
            'Match found, assign next color in array
            If UBound(ColorArray) < counter + 1 Then
                Selection.Interior.ColorIndex = ColorArray(0)
            Else
                Selection.Interior.ColorIndex = ColorArray(counter + 1)
            End If
            'Exit loop early, changed=True so 1st color isn't reassigned
            changed = True
            Exit For
        End If
    Next counter
    'No match found in array, assign 1st array color
    If changed = False Then Selection.Interior.ColorIndex = ColorArray(0)

'Use this if you want to change font color

    'Find background color to check against
    ColorBg = Selection.Font.ColorIndex
    'Loop through array to find a match
    For counter = LBound(ColorArray) To UBound(ColorArray)
        If ColorBg = ColorArray(counter) Then
            'Match found, assign next color in array
            If UBound(ColorArray) < counter + 1 Then
                Selection.Font.ColorIndex = ColorArray(0)
            Else
                Selection.Font.ColorIndex = ColorArray(counter + 1)
            End If
            'Exit loop early, changed=True so 1st color isn't reassigned
            changed = True
            Exit For
        End If
    Next counter
    'No match found in array, assign 1st array color
    If changed = False Then Selection.Font.ColorIndex = ColorArray(0)
End Sub

VBA字体颜色循环

2 个答案: