This article explains how you can change a gradient’s first and second color using VBA for Excel. It also provides a sample for getting the current gradient color used in a cell. Note the codes in this article assume a gradient already exists and we are only trying to modify its colors. Also note that each gradient has 2 colors, color1 and color2.
Jump To:
- Working With Gradients
- Example 1, Create Gradient With Different Colors
- Example 2, Multiple ColorStop Objects
–
Working With Gradients:
Please note that the codes below only change the gradients color. Therefore it is assumed that a gradient already exists in the cell under question. The article Excel VBA, Create Gradient explains how you can create a gradient using VBA.
A range object has the following object model:
The ColorStops object contains a collection of the ColorStop object:
Each ColorStop object has 2 main members:
Position: A double value between 0~1.
Color: The color associate with that position.
When you create a gradient, whether using VBA or using the gradient dialogs by default the gradient’s ColorStops collection has 2 ColorStop objects. One of the color stop objects has the position 1 and the other has the position 2:
In order to be able to fully use the gradient properties in VBA, I’d recommend changing the default positions to 0 and 1. this way we would be able to add position in between (i.e 0.5, 0.3) which is explained in the example below:
The code below creates a gradient in cell A1 and changes the default positions to 0 and 1:
Sub main()
Dim objColorStop As ColorStop
Dim lngColor1 As Long
Dim lngColor0 As Long
'creates the gradient in cell A1
Range("A1").Interior.Pattern = xlPatternLinearGradient
'changes its orientation
Range("A1").Interior.Gradient.Degree = 90
'gets the color code for the first colorstop object
lngColor0 = Range("A1").Interior.Gradient.ColorStops(1).Color
'gets the color code for the second colorstop object
lngColor1 = Range("A1").Interior.Gradient.ColorStops(2).Color
'clears the previous colostop objects
Range("A1").Interior.Gradient.ColorStops.Clear
'creates a colorstop object with the position 0
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(0)
'changes its color to the first color
objColorStop.Color = lngColor0
'creates a colorstop object with the position 1
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(1)
'changes its color to the second color
objColorStop.Color = lngColor1
End Sub
The code below creates the gradient. Note if a gradient already exists in cell A1 there would be no need for this line:
'creates the gradient in cell A1
Range("A1").Interior.Pattern = xlPatternLinearGradient
'changes its orientation
Range("A1").Interior.Gradient.Degree = 90
The code below gets the color codes for the first and second color used in the gradient. For more information about working with colors in VBA for Excel please see VBA Excel, Colors:
'gets the color code for the first colorstop object
lngColor0 = Range("A1").Interior.Gradient.ColorStops(1).Color
'gets the color code for the second colorstop object
lngColor1 = Range("A1").Interior.Gradient.ColorStops(2).Color
The line below removes the previous color stop objects:
Range("A1").Interior.Gradient.ColorStops.Clear
The line below creates a colorstop object at the position 0:
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(0)
The line below changes the new ColorStop objects color to the first color used in the initial gradient:
objColorStop.Color = lngColor0
–
Example 1, Create Gradient With Different Colors:
In this example we will create a gradient in cell A1 and change the first color to green:
Sub Example1_a()
Dim objColorStop As ColorStop
Dim lngColor1 As Long
'creates the gradient in cell A1
Range("A1").Interior.Pattern = xlPatternLinearGradient
'changes its orientation
Range("A1").Interior.Gradient.Degree = 90
'gets the color code for the second colorstop object
lngColor1 = Range("A1").Interior.Gradient.ColorStops(2).Color
'clears the previous colostop objects
Range("A1").Interior.Gradient.ColorStops.Clear
'creates a colorstop object with the position 0
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(0)
'changes its color to green
objColorStop.Color = vbGreen
'creates a colorstop object with the position 1
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(1)
'changes its color to red
objColorStop.Color = lngColor1
End Sub
The highlighted line changes the first color to green. Result:
We have also changed the second color to red:
Sub Example1_b()
Dim objColorStop As ColorStop
'creates the gradient in cell A1
Range("A1").Interior.Pattern = xlPatternLinearGradient
'changes its orientation
Range("A1").Interior.Gradient.Degree = 90
'clears the previous colostop objects
Range("A1").Interior.Gradient.ColorStops.Clear
'creates a colorstop object with the position 0
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(0)
'changes its color to green
objColorStop.Color = vbGreen
'creates a colorstop object with the position 1
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(1)
'changes its color to red
objColorStop.Color = vbRed
End Sub
The highlighted line changes the second color to red:
–
Example 2, Multiple ColorStop Objects:
In the previous example there was only 2 ColorStop objects. We can add as many ColorStop objects as we need. In the example below 4 ColorStop objects have been used:
| Color Stop | Color |
|---|---|
| 0 | |
| 0.33 | |
| 0.66 | |
| 1 |
The default ColorStop positions has been explained in the previous section. The code below will change the color at the position “0” to green. That means the white color will be replaced with green:
Sub Example2()
Dim objColorStop As ColorStop
Dim lngColor1 As Long
'creates the gradient in cell A1
Range("A1").Interior.Pattern = xlPatternLinearGradient
'changes its orientation
Range("A1").Interior.Gradient.Degree = 90
'clears the previous colostop objects
Range("A1").Interior.Gradient.ColorStops.Clear
'Creates the color stops for the gradient in cell A1
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(0)
objColorStop.Color = vbYellow
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(0.33)
objColorStop.Color = vbRed
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(0.66)
objColorStop.Color = vbGreen
Set objColorStop = Range("A1").Interior.Gradient.ColorStops.Add(1)
objColorStop.Color = vbBlue
End Sub
Result:
In the figure below you can see the resulting gradient with the colors and color stop index:
The line below changes the gradient’s first color to red. For more information about working with colors please see VBA Excel Colors:
Range("A1").Interior.Gradient.ColorStops(1).Color _
= ColorConstants.vbRed
Before:
After:
The line below changes the second color to green:
Range("A1").Interior.Gradient.ColorStops(2).Color _
= ColorConstants.vbGreen
Result:
The code below gets the color codes used for the first and second gradient colors and prints them in cells B2 and C2. For an example on working with color codes please see Excel VBA, Color Code:
Cells(2, 2) = _
Range("A1").Interior.Gradient.ColorStops(1).Color
Cells(2, 3) = _
Range("A1").Interior.Gradient.ColorStops(2).Color
Result:
Note: Intellisense may cease to display after .gradient.
Note: In this section It is assumed that a gradient has already been created for cell A1. We are just trying to modify it. For more information about creating gradients please see Excel VBA, Create Gradient.
See also:
- Excel VBA, Fill Effects, Gradient
- Excel VBA, Formatting Cells and Ranges Using the Macro Recorder
- Excel VBA, Color Code
If you need assistance with your code, or you are looking for a VBA programmer to hire feel free to contact me. Also please visit my website www.software-solutions-online.com
I have two functions here, each one displays the gradient slightly differently with up to 5 gradients.
Function 1:
Function addCellColor(ByVal c As Range, ByVal color As Long)
Dim c1 As Long, c2 As Long, c3 As Long, c4 As Long
'creates a gradient pattern if one doesn't already exist
With c.Interior
If .color = 16777215 Then
.Pattern = xlPatternLinearGradient
.gradient.Degree = 0
.gradient.ColorStops.Clear
End If
End With
' adds gradient color to cell up to 5 colors
If Not c.Interior.gradient Is Nothing Then
With c.Interior.gradient
' if the cell is already colored
If .ColorStops.count <> 0 Then
Select Case .ColorStops.count
Case 2
If .ColorStops(1).color = .ColorStops(2).color Then
c1 = .ColorStops(1).color
.ColorStops.Clear
.ColorStops.Add(0).color = c1
.ColorStops.Add(0.45).color = c1
.ColorStops.Add(0.55).color = color
.ColorStops.Add(1).color = color
End If
Case 4
If .ColorStops(1).color <> color And .ColorStops(2).color <> color And .ColorStops(3).color <> color And .ColorStops(4).color <> color Then
c1 = .ColorStops(1).color: c2 = .ColorStops(3).color
.ColorStops.Clear
.ColorStops.Add(0).color = c1
.ColorStops.Add(0.28).color = c1
.ColorStops.Add(0.38).color = c2
.ColorStops.Add(0.61).color = c2
.ColorStops.Add(0.71).color = color
.ColorStops.Add(1).color = color
End If
Case 6
If .ColorStops(1).color <> color And .ColorStops(2).color <> color And .ColorStops(3).color <> color _
And .ColorStops(4).color <> color And .ColorStops(5).color <> color And .ColorStops(6).color <> color Then
c1 = .ColorStops(1).color: c2 = .ColorStops(3).color: c3 = .ColorStops(5).color
.ColorStops.Clear
.ColorStops.Add(0).color = c1
.ColorStops.Add(0.2).color = c1
.ColorStops.Add(0.3).color = c2
.ColorStops.Add(0.45).color = c2
.ColorStops.Add(0.55).color = c3
.ColorStops.Add(0.7).color = c3
.ColorStops.Add(0.8).color = color
.ColorStops.Add(1).color = color
End If
Case 8
If .ColorStops(1).color <> color And .ColorStops(2).color <> color And .ColorStops(3).color <> color And .ColorStops(4).color <> color _
And .ColorStops(5).color <> color And .ColorStops(6).color <> color And .ColorStops(7).color <> color And .ColorStops(8).color <> color Then
c1 = .ColorStops(1).color: c2 = .ColorStops(3).color: c3 = .ColorStops(5).color: c4 = .ColorStops(7).color
.ColorStops.Clear
.ColorStops.Add(0).color = c1
.ColorStops.Add(0.15).color = c1
.ColorStops.Add(0.25).color = c2
.ColorStops.Add(0.35).color = c2
.ColorStops.Add(0.45).color = c3
.ColorStops.Add(0.55).color = c3
.ColorStops.Add(0.65).color = c4
.ColorStops.Add(0.75).color = c4
.ColorStops.Add(0.85).color = color
.ColorStops.Add(1).color = color
End If
End Select
' if cell has no colors yet
Else
.ColorStops.Add(0).color = color
.ColorStops.Add(1).color = color
End If
End With
End If
End Function
Output (completes in 2 minutes and 10 seconds when ran on a collection of ~4500 items):
Function 2:
Function addCellColor1(ByVal c As Range, ByVal color As Long)
Dim c1 As Long, c2 As Long, c3 As Long, c4 As Long
'creates a gradient pattern if one doesn't already exist
With c.Interior
If .color = 16777215 Then
.Pattern = xlPatternLinearGradient
.gradient.Degree = 0
.gradient.ColorStops.Clear
End If
End With
' adds gradient color to cell up to 5 colors
If Not c.Interior.gradient Is Nothing Then
With c.Interior.gradient
' if the cell is already colored
If .ColorStops.count <> 0 Then
Select Case .ColorStops.count
Case 2
If .ColorStops(1).color = .ColorStops(2).color Then
.ColorStops(2).color = color
ElseIf .ColorStops(1).color <> color And .ColorStops(2).color <> color Then
c1 = .ColorStops(1).color: c2 = .ColorStops(2).color
.ColorStops.Clear
.ColorStops.Add(0).color = c1
.ColorStops.Add(0.5).color = c2
.ColorStops.Add(1).color = color
End If
Case 3
If .ColorStops(1).color <> color And .ColorStops(2).color <> color And .ColorStops(3).color <> color Then
c1 = .ColorStops(1).color: c2 = .ColorStops(2).color: c3 = .ColorStops(3).color
.ColorStops.Clear
.ColorStops.Add(0).color = c1
.ColorStops.Add(0.33).color = c2
.ColorStops.Add(0.66).color = c3
.ColorStops.Add(1).color = color
End If
Case 4
If .ColorStops(1).color <> color And .ColorStops(2).color <> color And .ColorStops(3).color <> color And .ColorStops(4).color <> color Then
c1 = .ColorStops(1).color: c2 = .ColorStops(2).color: c3 = .ColorStops(3).color: c4 = .ColorStops(4).color
.ColorStops.Clear
.ColorStops.Add(0).color = c1
.ColorStops.Add(0.25).color = c2
.ColorStops.Add(0.5).color = c3
.ColorStops.Add(0.75).color = c4
.ColorStops.Add(1).color = color
End If
End Select
' if cell has no colors yet
Else
.ColorStops.Add(0).color = color
.ColorStops.Add(1).color = color
End If
End With
End If
End Function
Output (completes in 1 minute and 12 seconds when ran on a collection of ~4500 items):
It is recommended to have the below function run before this one
Function Opt_Start()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False
Application.DisplayAlerts = False
End function
Particularly looking for an optimization review since the functions take a long time to run when it is ran in a loop.
Additional info:
I have collected a large amount of data in a VBA Collection that looks like this:
The data collection for this (approx 4500 items) takes about 5 seconds, the gradient fill takes minutes.
This is all I am permitted to share: This is how the cell colors are determined.
Private Function FormatDocument()
Dim p As FormulaParameter
Dim green As Long, orange As Long, lRed As Long, dRed As Long, magenta As Long, dGrey As Long
Debug.Print ("Formatting Cells")
green = RGB(146, 208, 80)
orange = RGB(255, 192, 0)
lRed = RGB(255, 80, 80)
dRed = RGB(192, 0, 0)
magenta = RGB(252, 117, 255)
dGrey = RGB(120, 120, 120)
For Each p In coll
If Not p Is Nothing Then
With p
' Error 2: Step name not found for the operation parameter
' this error will just be logged no format changes
'Cell is orange if the value in that cell has been modified at all. Overrides others.
' if error says "Parameter was tracked successfully." change the formula and unit level defenition if not = "Operation default"
' if it is an operation default value, change the unit parameter to its default value
If .newValue = "Operation Default" Then
'********************** This block will change UP level parameter ***************************************
'If Not .uParam Is Nothing Then
' .uParam.Offset(0, 1).value = .defValue
' Call addCellColor(.uParam.Offset(0, 1), orange)
' Call ReplaceUnits(.uParam.Offset(0, 2))
'End If
'********************** This block will change UP level parameter ***************************************
'************ This line will change OP level parameter and delete UP parameter **************************
If Not .oParam2 Is Nothing Then
.oParam2.Offset(0, 1).value = .defValue
Call addCellColor(.oParam2.Offset(0, 1), orange)
Call ReplaceUnits(.oParam2.Offset(0, 2))
If Not .uParam Is Nothing Then
.uParam.Offset(0, 1).value = ""
.uParam.value = ""
.uParam.Offset(0, -1).value = "VALUE"
.uParam.Offset(0, -1).Font.color = vbRed
End If
End If
'************ This line will change OP level parameter and delete UP parameter **************************
Else
If Not .fParam Is Nothing And .newValue <> "" Then .fParam.Offset(0, .fOffset).value = .newValue
If Not .fParam Is Nothing And .newValue <> "" Then Call addCellColor(.fParam.Offset(0, .fOffset), orange)
End If
' Error 10: there was not a unit parameter for the corresponding operation parameter on uTab
' This will also have a default value put into the value in UP
If InStr(1, .error, "Error 10:") > 0 And .newValue = "Operation Default" Then
' .uParam.Offset(0, 1).value = .defValue ' this will change if changing at operation level
' If Not .uParam Is Nothing Then Call addCellColor(.uParam.Offset(0, 1), orange)
'************************************************ added for op level change
If Not .oParam2 Is Nothing Then
.oParam2.Offset(0, 1).value = .defValue
Call addCellColor(.oParam2.Offset(0, 1), orange)
Call ReplaceUnits(.oParam2.Offset(0, 2))
If Not .oParam1 Is Nothing Then
.oParam1.Offset(0, 4).value = ""
.oParam1.Offset(0, 2).value = "VALUE"
.oParam1.Offset(0, 2).Font.color = vbRed
End If
End If
'************************************************ added for op level change
End If
'Cell is green if the value, or parameter in that cell was able to be tracked successfully throughout the two documents.
' catches unit level parameters
' if error says "Parameter was tracked successfully."
If .error = "Parameter was tracked successfully." Or .error = "Parameter is a Unit Procedure level defenition" Then
If Not .uParam Is Nothing Then Call addCellColor(.uParam, green)
If Not .oParam1 Is Nothing Then Call addCellColor(.oParam1, green)
If Not .oParam2 Is Nothing Then Call addCellColor(.oParam2, green)
If Not .rParam Is Nothing Then Call addCellColor(.rParam, green)
If Not .pParam Is Nothing Then Call addCellColor(.pParam, green)
If Not .pParam Is Nothing Then Call addCellColor(.pParam.Offset(0, .pOffset), green)
If Not .pParam Is Nothing Then Call addCellColor(.pParam.Offset(0, .dOffset), green)
If .error = "Parameter is a Unit Procedure level defenition" And Not .fParam Is Nothing Then Call addCellColor(.fParam.Offset(0, .fOffset), green)
End If
'Cell is light red due to a possible mismatch in the R_ parameter from the OP tabs to the PH tabs or vice versa.
' Error 1: Parameter in formula was not found in an operation OR
' Error 2: Step name not found for the operation parameter OR
' Error 3: Operation tab was not found
' Error 4: Operation parameter not found in operation tab
' Error 6: Recipe parameter not found in phase tab
' Error 8: Recipe parameter in the phase was not found in the operation
' Error 9: operation parameter from the operation was not found in the Unit procedure
If InStr(1, .error, "Error 1:") > 0 Or InStr(1, .error, "Error 2:") > 0 Or InStr(1, .error, "Error 4:") > 0 _
Or InStr(1, .error, "Error 6:") > 0 Or InStr(1, .error, "Error 8:") > 0 Or InStr(1, .error, "Error 9:") > 0 _
Or InStr(1, .error, "Error 3:") > 0 Then
If Not .pParam Is Nothing Then Call addCellColor(.pParam, lRed)
If Not .pParam Is Nothing Then Call addCellColor(.pParam.Offset(0, .dOffset), lRed)
If Not .pParam Is Nothing Then Call addCellColor(.pParam.Offset(0, .pOffset), lRed)
If Not .rParam Is Nothing Then Call addCellColor(.rParam, lRed)
If Not .oParam1 Is Nothing Then Call addCellColor(.oParam1, lRed)
If Not .oParam2 Is Nothing Then Call addCellColor(.oParam2, lRed)
If Not .uParam Is Nothing Then Call addCellColor(.uParam, lRed)
If Not .fParam Is Nothing Then Call addCellColor(.fParam.Offset(0, .fOffset), lRed)
End If
'Cell is dark red if the parameter is blank in the parameter value document.
' Error 10: there was not a unit parameter for the corresponding operation parameter on uTab
' or the parameter is empty in phase tab
If InStr(1, .error, "Error 10:") > 0 Or (Not .pParam Is Nothing And .newValue = "" And .pOffset <> 0) Then
If Not .pParam Is Nothing Then Call addCellColor(.pParam, dRed)
If Not .pParam Is Nothing Then Call addCellColor(.pParam.Offset(0, .dOffset), dRed)
If Not .pParam Is Nothing Then Call addCellColor(.pParam.Offset(0, .pOffset), dRed)
If Not .rParam Is Nothing Then Call addCellColor(.rParam, dRed)
If Not .uParam Is Nothing Then Call addCellColor(.uParam, dRed)
If Not .oParam1 Is Nothing Then Call addCellColor(.oParam1, dRed)
If Not .oParam2 Is Nothing Then Call addCellColor(.oParam2, dRed)
If Not .fParam Is Nothing Then Call addCellColor(.fParam.Offset(0, .fOffset), dRed)
End If
'Cell is magenta if there were no parameter values found for this phase on this column/formula.
' Error 7: There does not exist parameter value for this phase on this formula
' Error 5: Phase tab was not found
If InStr(1, .error, "Error 5:") > 0 Or InStr(1, .error, "Error 7:") > 0 Then
If Not .fParam Is Nothing Then Call addCellColor(.fParam.Offset(0, .fOffset), magenta)
If Not .uParam Is Nothing Then Call addCellColor(.uParam, magenta)
If Not .oParam1 Is Nothing Then Call addCellColor(.oParam1, magenta)
If Not .oParam2 Is Nothing Then Call addCellColor(.oParam2, magenta)
If Not .rParam Is Nothing Then Call addCellColor(.rParam, magenta)
End If
'Cell is dark grey if the value, or parameter in that cell is operation default. (Some may be light grey)
' para.newValue = operation default
If .newValue = "Operation Default" Then
If Not .rParam Is Nothing Then Call addCellColor(.rParam, dGrey)
If Not .oParam1 Is Nothing Then Call addCellColor(.oParam1, dGrey)
If Not .oParam2 Is Nothing Then Call addCellColor(.oParam2, dGrey)
If Not .uParam Is Nothing Then Call addCellColor(.uParam, dGrey)
If Not .fParam Is Nothing Then Call addCellColor(.fParam.Offset(0, .fOffset), dGrey)
End If
'Cell is white if that cell was not able to be checked across documents, or invalid entries exist. Most commonly the cells are white because
'they did not exist in the formula but they did in the operation, or they did not exist in the parameter document. Cells white in parameter
'document because they were never looked at due to mismatched names.
End With
End If
Next p
End Function
Linked question on StackOverflow
What is the best way to apply horizontal gradient fill effect to a cell through macro code?
I’ve set the desired gradient in Excel (right-click on cell B1, Format Cells…, Fill, Fill Effects, Two Colors, Horizontal, «Okay» all).
I then have the following code to find out how to represent this via code. When I step through the code, I can use the locals window to inspect the gradient and colorstops of the myrange object:
Dim myrange As range
Set myrange = ActiveSheet.range("B1")
Using this information, I can now hard-code the information in a macro, in hopes of duplicating the gradient fill by code:
'First, delete any previous gradient colorstops
For Each cs In myrange.Interior.Gradient.ColorStops
cs.Delete
Next
'Then, assign the desired colorstops in the gradient
With myrange.Interior.Gradient.ColorStops
.add color = 16777215
Position = 0
ThemeColor = 1
TintAndShade = 0
.add color = 7961087
Position = 0.5
ThemeColor = 0
TintAndShade = 0
.add color = 16777215
Position = 1
ThemeColor = 1
TintAndShade = 0
End With
Unfortunately, this results in something that looks totally wrong. The most obvious thing that’s wrong is that the gradient is in black and white, even as I adjust the RGB values.
Is there something else that should be added here?
Как применить градиент цвета к нескольким ячейкам?
В Excel мы можем легко заполнить цвет фона для ячейки или нескольких ячеек, но иногда нам нужно, чтобы цвет был заполнен градиентом, как показано на следующем снимке экрана, как можно получить градиент цвета в ячейке или нескольких ячейках в Excel?
Применить цвет градиента к одной ячейке с помощью функции форматирования ячеек
Применение цвета градиента к нескольким ячейкам с кодом VBA
Применить цвет градиента к одной ячейке с помощью функции форматирования ячеек
Применить цвет градиента к одной ячейке с помощью функции форматирования ячеекВ Excel функция форматирования ячеек может помочь вам заполнить цветовой градиент в одной ячейке, пожалуйста, сделайте следующее:
1. Выберите ячейку или несколько ячеек, которые вы хотите заполнить градиентом цвета для каждой ячейки, а затем щелкните правой кнопкой мыши, чтобы выбрать Формат ячеек из контекстного меню в Формат ячеек диалоговое окно под Заполнять вкладку, пожалуйста, нажмите Заливки кнопку, см. снимок экрана:
2. В Заливки диалоговом окне выберите два цвета, которые вы хотите использовать, из двух раскрывающихся списков Цвета раздел, а затем выберите один из стилей затенения по своему усмотрению, например горизонтальный, вертикальный и т. д. Смотрите скриншот:
3. Затем нажмите OK > OK чтобы закрыть диалоговые окна, и цвет градиента заполняется для каждой ячейки, как показано на следующем снимке экрана:
Применение цвета градиента к нескольким ячейкам с кодом VBA
Вышеупомянутый метод может помочь нам создать цветовой градиент в отдельной ячейке. Если вам нужно затенять цветовой градиент в нескольких ячейках, вам нужно применить код VBA для его решения.
1. Сначала залейте определенный цвет фона для диапазона ячеек.
2. Удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.
3. Нажмите Вставить > Модулии вставьте следующий код в Модули Окно.
Код VBA: применить цвет градиента к нескольким ячейкам:
Sub colorgradientmultiplecells()
'Updateby Extendoffcie
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xColor As Long
Dim I As Long
Dim K As Long
Dim xCount As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
LInput:
Set xRg = Application.InputBox("please select the cells range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
If xRg.Areas.Count > 1 Then
MsgBox "does not support multiple selections", vbInformation, "Kutools for Excel"
GoTo LInput
End If
On Error Resume Next
Application.ScreenUpdating = False
xCount = xRg.Rows.Count
For K = 1 To xRg.Columns.Count
xColor = xRg.Cells(1, K).Interior.Color
For I = xCount To 1 Step -1
xRg.Cells(I, K).Interior.Color = xColor
xRg.Cells(I, K).Interior.TintAndShade = (xCount - (I - 1)) / xCount
Next
Next
End Sub
4, Затем нажмите F5 нажмите клавишу для запуска этого кода, и появится окно подсказки, напоминающее вам о выборе цветных ячеек, которые вы хотите заполнить цветом градиента, см. снимок экрана:
5, Затем нажмите OK , цвет в нескольких ячейках отображается как цвет градиента, см. снимок экрана:
Лучшие инструменты для работы в офисе
Kutools for Excel Решит большинство ваших проблем и повысит вашу производительность на 80%
- Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма …
- Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон…
- Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы… Предотвращение дублирования ячеек; Сравнить диапазоны…
- Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор …
- Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое …
- Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии…
- Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом …
- Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF…
- Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
Вкладка Office: интерфейс с вкладками в Office и упрощение работы
- Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
- Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
- Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
What This VBA Code Does
This will give you a sample of the different types of cell fills you can have in Excel
Using VBA Code Found On The Internet
Now that you’ve found some VBA code that could potentially solve your Excel automation problem, what do you do with it? If you don’t necessarily want to learn how to code VBA and are just looking for the fastest way to implement this code into your spreadsheet, I wrote an article (with video) that explains how to get the VBA code you’ve found running on your spreadsheet.
Getting Started Automating Excel
Are you new to VBA and not sure where to begin? Check out my quickstart guide to learning VBA. This article won’t overwhelm you with fancy coding jargon, as it provides you with a simplistic and straightforward approach to the basic things I wish I knew when trying to teach myself how to automate tasks in Excel with VBA Macros.
Also, if you haven’t checked out Excel’s latest automation feature called Power Query, I have put together a beginner’s guide for automating with Excel’s Power Query feature as well! This little-known built-in Excel feature allows you to merge and clean data automatically with little to no coding!
How Do I Modify This To Fit My Specific Needs?
Chances are this post did not give you the exact answer you were looking for. We all have different situations and it’s impossible to account for every particular need one might have. That’s why I want to share with you: My Guide to Getting the Solution to your Problems FAST! In this article, I explain the best strategies I have come up with over the years to get quick answers to complex problems in Excel, PowerPoint, VBA, you name it!
I highly recommend that you check this guide out before asking me or anyone else in the comments section to solve your specific problem. I can guarantee that 9 times out of 10, one of my strategies will get you the answer(s) you are needing faster than it will take me to get back to you with a possible solution. I try my best to help everyone out, but sometimes I don’t have time to fit everyone’s questions in (there never seem to be quite enough hours in the day!).
I wish you the best of luck and I hope this tutorial gets you heading in the right direction!
Chris
Founder, TheSpreadsheetGuru.com