VBA字體顏色循環

Question

我想創建一個循環不同顏色的VBA代碼。例如。當我按ctrl + m第一次我想它是藍色的，那麼如果我按下相同的快捷鍵，它會變成紅色，然後等其他顏色。如果我需要更改它們，也希望能夠添加和取出顏色，所以如果有人能夠解釋他們方程的顏色陣列部分，這對我自己進行編輯會很棒

Answer 1

This website provides a chart of the basic 56 colors。如果需要，在'調色板'上搜索將幫助您找到其他人。數組從0開始，所以我建議以這種方式保持數組。使用我鏈接的圖表，您可以根據需要爲陣列添加儘可能多的顏色。只要確保更新ColorArray的數字序列並將ReDim行更改爲序列中的最後一個數字即可。

下面的代碼分配給Ctrl鍵米和刪除任一的代碼背景或字體顏色的部分。無論您選擇何種單元格，當您點擊時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 

Answer 2

嘗試分配Ctrl + 米到該宏：

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