用vba实现中心单元格向外的渐变效果
实现效果:
代码:
Dim rng As Range
Dim cell As Range
Dim centerX, centerY As Double
Dim maxDistance As Double
' 设置要操作的区域
Set rng = Range("A1:CV100")
' 计算中心点坐标
centerX = (rng.Columns.Count + 1) / 2
centerY = (rng.Rows.Count + 1) / 2
' 计算最大距离
maxDistance = WorksheetFunction.Max(Abs(centerX - 1), Abs(centerX - rng.Columns.Count), _
Abs(centerY - 1), Abs(centerY - rng.Rows.Count))
' 修改单元格颜色
For Each cell In rng
Dim distanceX As Double
Dim distanceY As Double
distanceX = Abs(cell.Column - centerX)
distanceY = Abs(cell.Row - centerY)
Dim shade As Double
If distanceX > distanceY Then
shade = (distanceX / ((rng.Columns.Count - 1) / 2)) * 255
Else
shade = (distanceY / ((rng.Rows.Count - 1) / 2)) * 255
End If
' 根据归一化后的距离计算颜色
Dim shadeInt As Integer
shadeInt = WorksheetFunction.RoundUp(shade, 0)
' 修改单元格颜色
cell.Interior.Color = RGB(shadeInt, shadeInt, shadeInt)
Next cell
End Sub