如何在Excel中循环显示边框并更改其颜色? [英] How to cycle through borders in Excel and change their color?
问题描述
我试图在Excel中的活动边框之间循环,并将其颜色更改为下一个".
I am trying to cycle through active borders in Excel and to change their colors to "next one".
这是我的代码:
Dim Color1 As Variant
Dim Color2 As Variant
Dim Color3 As Variant
Dim Color4 As Variant
Dim Color5 As Variant
Color_default = RGB(0, 0, 0)
Color1 = RGB(255, 0, 0)
Color2 = RGB(0, 255, 0)
Color3 = RGB(0, 0, 255)
Color4 = RGB(222, 111, 155)
Color5 = RGB(111, 111, 111)
Dim cell As Range
Dim positions As Variant
Dim i As Integer
positions = Array(xlDiagonalDown, xlDiagonalDown, xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
For Each cell In Selection
For i = LBound(positions) To UBound(positions)
If cell.BORDERS(positions(i)).LineStyle <> xlNone Then
If cell.BORDERS(positions(i)).Color = Color_default Then
cell.BORDERS(positions(i)).Color = Color1
ElseIf cell.BORDERS(positions(i)).Color = Color1 Then
cell.BORDERS(positions(i)).Color = Color2
ElseIf cell.BORDERS(positions(i)).Color = Color2 Then
cell.BORDERS(positions(i)).Color = Color3
ElseIf cell.BORDERS(positions(i)).Color = Color3 Then
cell.BORDERS(positions(i)).Color = Color4
ElseIf cell.BORDERS(positions(i)).Color = Color4 Then
cell.BORDERS(positions(i)).Color = Color5
Else
cell.BORDERS(positions(i)).Color = Color_default
End If
End If
Next i
Next cell
有效.它不会更改边框的粗细,也不会添加新边框(仅更改现有边框).
It works. It does not change the weight of the borders and it does not add new borders (only changes the existing ones).
问题是,当两个像元在附近时,它们的外部边界会变成"next + 1"颜色,而内部边界会变成"next + 2"颜色,因为它们循环了两次.
The issue is that when two cells are nearby, the outer borders are changes to "next+1" color, and the inner borders are changed to "next+2" color, as they are looped through two times.
该代码应检查现有的边框颜色是否是我要使用的颜色.其次,应首先统一颜色,以避免选择中出现多个边框颜色.
The code should check if the existing border colors are the ones I want to use. Secondly, the colors should be unified first, to avoid multiple border colors within selection.
问题图片
我想统一边框,然后能够在其颜色之间循环显示,无论它们的重量是多少,而且都无需添加新边框.
I want to unify the borders and then be able to cycle through their colors, regardless what their weight is and without adding NEW borders.
推荐答案
此代码应执行您想要的操作.它从所选内容中带有边框的单元格中读取现有颜色,确定要设置的下一个颜色,并相应地设置所有颜色.
This code should do what you want. It reads the existing color from a framed cell within the selection, determines which is the next color to set and sets all colours accordingly.
Sub CycleBorderColors(Optional ByVal Reset As Boolean)
Dim BorderColor As Variant
Dim BorderPos As Variant
Dim CurrentColor As Long
Dim ColorIndex As Long
Dim Cell As Range
Dim i As Integer
BorderPos = Array(xlDiagonalDown, xlDiagonalUp, xlEdgeLeft, xlEdgeTop, _
xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
BorderColor = Array(RGB(0, 0, 0), RGB(255, 0, 0), RGB(0, 255, 0), _
RGB(222, 111, 155), RGB(111, 111, 111))
If Reset Then
ColorIndex = Reset
Else
CurrentColor = xlNone
' read the border color of the first selected cell with a border
For Each Cell In Selection.Cells
For i = LBound(BorderPos) To UBound(BorderPos)
With Cell
If .Borders(BorderPos(i)).LineStyle <> xlNone Then
CurrentColor = .Borders(BorderPos(i)).Color
Exit For
End If
End With
Next i
If CurrentColor <> xlNone Then Exit For
Next Cell
If CurrentColor = xlNone Then
MsgBox "The selection includes no cells with borders.", _
vbInformation, "Inapplicable selection"
Exit Sub
End If
For ColorIndex = UBound(BorderColor) To 0 Step -1
If BorderColor(ColorIndex) = CurrentColor Then Exit For
Next ColorIndex
' ColorIndex will be -1 if not found
End If
ColorIndex = ColorIndex + 1 ' set next color
If ColorIndex > UBound(BorderColor) Then ColorIndex = 0
For Each Cell In Selection
For i = LBound(BorderPos) To UBound(BorderPos)
If Cell.Borders(BorderPos(i)).LineStyle <> xlNone Then
Cell.Borders(BorderPos(i)).Color = BorderColor(ColorIndex)
End If
Next i
Next Cell
End Sub
该过程具有一个可选参数,如果将其设置为True,则会导致重置.当前程序将边框颜色设置为默认值.在事后看来,这个想法并不那么热烈,因为您可以通过运行4次或更少的代码来导致重置.但是当我开始的时候,这似乎是个好主意.现在,您可能希望删除该功能.最简单的方法是从声明中删除参数,将
The procedure has an optional argument which, if set to True, causes a reset. The current program sets the border color to default. In hindsight the idea isn't so hot because you could cause a reset by running the code 4 or fewer times. But when I started it seemed like a good idea. Now you may prefer to remove the feature. The easiest way would be to remove the argument from the declaration, add Dim Reset As Boolean
to the variable declarations and leave the rest to itself.
虽然您确实可以选择重置,但可以使用中介程序来调用该过程.下面显示的三个变体中的任何一个都可以使用.
While you do have the the option to reset use an intermediary to call the procedure. Any of the three variants shown below will work.
Sub CallCycleBorderColors()
CycleBorderColors
' CycleBorderColors True
' CycleBorderColors False
End Sub
从工作表中调用子 CallCycleBorderColors
.
这篇关于如何在Excel中循环显示边框并更改其颜色?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!