0

我需要编写一个宏：我用紫色填充 A1。然后当我运行宏时，A2 应该更轻一点，A3 更轻......等等，直到 A20 是白色的。但是这种颜色变化不应该是成比例的，即“变得更亮”的单元格中的边缘颜色变化应该下降（使得 A2 比 A1 更亮，比 A3 比 A2 更亮）。底线是：细胞应该变得更轻，但不成比例。

在此处输入图像描述

到目前为止，我有以下代码：

Sub Macro3()

Dim firstCell As Range 'the first cell, and the cell whose color will be used for all others.
Dim cellColor As Long 'the cell color that you will use, based on firstCell
Dim allCells As Range 'all cells in the column you want to color
Dim c As Long  'cell counter
Dim tintFactor As Double 'computed factor based on # of cells.
Dim contrast As Integer

Set firstCell = Range("A1")
cellColor = firstCell.Interior.Color
contrast = Range("F5").Value


Set allCells = Range("A1:A20")

For c = allCells.Cells.Count To 1 Step -1
    allCells(c).Interior.Color = cellColor
    allCells(c).Interior.TintAndShade = contrast * _
        (c - 1) / allCells.Cells.Count
  Next

End Sub

我试图在Dim contrast as Integer单元格“F5”中引入一个整数变量，这样当我改变“F5”中的值时，颜色的边际减少会下降。但这不起作用。如何改进代码？

4

2 回答 2

2

下面是带有tan函数的代码，结果如下图：

在此处输入图像描述

在 B 列中，您会发现 T&S 颜色参数之间的差异。

Sub Macro3_proposal()

Dim firstCell As Range 'the first cell, and the cell whose color will be used for all others.
Dim cellColor As Long 'the cell color that you will use, based on firstCell
Dim allCells As Range 'all cells in the column you want to color
Dim c As Long  'cell counter
Dim tintFactor As Double 'computed factor based on # of cells.
Dim contrast As Integer

Set firstCell = Range("A1")
cellColor = firstCell.Interior.Color
contrast = Range("F5").Value


Set allCells = Range("A1:A20")

Dim allCellsCount!
allCellsCount = allCells.Cells.Count - 1
For c = 1 To allCellsCount 
    allCells(c + 1).Interior.Color = cellColor

    allCells(c + 1).Value = contrast * (Tan(c / allCellsCount) / Tan(1))
    allCells(c + 1).Interior.TintAndShade = contrast * (Tan(c / allCellsCount) / Tan(1))
  Next

End Sub
于 2013-04-28T21:45:00.450 回答
2

在单元格 F5 上进行数据验证，其内容应介于 -1 和 1 之间，然后更改代码以使对比度不是整数，而是 Double（浮点）：

Sub Macro3()

    Dim firstCell As Range 'the first cell, and the cell whose color will be used for all others.
    Dim cellColor As Long 'the cell color that you will use, based on firstCell
    Dim allCells As Range 'all cells in the column you want to color
    Dim c As Long  'cell counter
    Dim tintFactor As Double 'computed factor based on # of cells.
    Dim contrast As Double 'double precision factor for changing the contrast 0= none higher is more

    Set firstCell = Range("A1")
    cellColor = firstCell.Interior.Color
    contrast = Range("F5").Value


    Set allCells = Range("A1:A20")

    For c = allCells.Cells.Count To 1 Step -1
        allCells(c).Interior.Color = cellColor
        allCells(c).Interior.TintAndShade = _
            contrast * (c - 1) / (allCells.Cells.Count -1)

    Next

End Sub

值 0 是所有相同的颜色，最多 1 将增加底部的白色，减少到 -1 将增加底部的黑色。该值不能超过 -1 或 1，因此这些是您的 Cell F5 限制。

在自动更新你漂亮的颜色丝带旁边添加一个Worksheet_Change子到你的 VBA：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F5")) Is Nothing Then
        Call Macro3
    End If
End Sub

可以了，好了！

于 2013-04-28T20:35:01.713 回答