8

我需要编写一个宏：我用黑色填充 A1。然后当我运行宏时，A2 应该更轻一点，A3 更轻......等等，直到 A20 是白色的。“F5”单元格值应控制梯度指数的程度。当前代码按比例更改颜色。当我更改“F5”中的值（例如从 1 到 0.7）时，所发生的情况是这 20 个单元格（“A1:A20”）中的所有单元格都变暗了。最后一个单元格 A20 不再是白色的了。

但是，无论如何，我都需要我的第一个单元格“A1”为黑色，最后一个单元格“A20”为白色......而且，单元格的颜色分布应该是指数的，即 A1 和 A2 之间的暗度差异应该是 A3 和 A2 之间的暗度差异的两倍（如果“F5”==2），等等......

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

我不知道，我应该在上面实现什么函数，以便颜色的变化是指数的，因为我改变了contrast“F5”中变量的值？// 和

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

在此处输入图像描述

4

2 回答 2

6

您不能同时拥有“下一个单元格是白色的两倍”和“第一个单元格是黑色，最后一个单元格是白色”。您正在寻找的是一种称为“伽玛函数”的东西 - 数字从 0 到 255 的缩放程度，其中它们变轻的速率取决于一个因素（有时称为伽玛）。

在其基本形式中，您可以使用以下内容：

contrast = ((cellNum-1)/(numCells-1))^gamma

现在，如果您的 gamma 为 1，则缩放将是线性的。当 gamma > 1 时，最后几个细胞的强度会增加得更快。当它小于 1 时，它会在前几个单元格中快速变化。

我在上面假设cellNum从 1 到 20，也numCells就是 20。这个对比度值，在.TintAndShade你使用的表达式中，应该会给你你正在寻找的效果。gamma不需要是整数，但如果它 < 0，您将得到对比度 > 1，这会给您带来奇怪的结果（我想全是白色的）。

顺便说一句 - 将您的 macro3 重命名为更合理的名称 ( adjustContrast)，并使用 F5 的值作为参数调用它：

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("F5")) Is Nothing Then
    adjustContrast Target.Value
  End If
End Sub

和

Sub adjustContrast(gamma)
  ... etc

由于从您的评论中可以清楚地看出我在原始帖子中不够明确，因此这里是完整的代码，以及它给我的结果。注意 - 这是演示更改 gamma 对显示器的影响的代码，而不是您要使用的确切代码（例如，我循环四列并有四个不同的 gamma 值）：

Sub applyGamma()
Dim ii, jj As Integer
Dim contrast As Double
Dim cellColor, fontColor, fontInvColor As Long
Dim allCells As Range
Dim gamma As Double

On Error GoTo recovery
Application.ScreenUpdating = False
Set allCells = [A2:A21]

' default formatting taken from cell A1
cellColor = [A1].Interior.Color
fontColor = [A1].Font.Color
fontInvColor = 16777215 - fontColor ' use the "inverse" color... sloppy way to always see the numbers

For jj = 1 To 4
  Set allCells = allCells.Offset(0, 1)
  gamma = Cells(1, jj + 1).Value ' pick gamma from the column header
  For ii = 1 To 20 ' loop over all the cells
    contrast = ((ii - 1) / 19) ^ gamma ' pick the contrast for this cell
    allCells.Cells(ii, 1).Interior.Color = cellColor
    allCells(ii, 1).Interior.TintAndShade = contrast
    If contrast > 0.5 Then allCells.Cells(ii, 1).Font.Color = fontInvColor Else allCells(ii, 1).Font.Color = fontColor

  Next ii
  ' repeat for next column:
Next jj

recovery:
Application.ScreenUpdating = True

End Sub

在我运行代码之前，我的屏幕看起来像这样（单元格中的值是给定 gamma 的计算对比度值）：

在此处输入图像描述

运行后，它看起来像这样：

在此处输入图像描述

如您所见，我添加了一个额外的“功能”：更改字体的颜色以保持可见性。当然，这假设“模板单元格”（在我的例子中是A1）在字体和填充颜色之间具有良好的对比度。

于 2013-04-29T04:43:52.117 回答
4

要让它以指数方式工作，您可以尝试使用以下结果的逻辑：

在此处输入图像描述

与您的代码相比，以下代码略有变化：

Sub Macro3_proposal_revers()

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("B1")
cellColor = firstCell.Interior.Color
    contrast = Range("F5").Value

Set allCells = Range("B1:B20")

Dim allCellsCount!
allCellsCount = allCells.Cells.Count - 1
Dim newContrast As Double
For c = 1 To allCells.Cells.Count - 1

    allCells(c + 1).Interior.Color = cellColor
    'var 1
    newContrast = (1 - 0.9 ^ (c * (1 + (c / allCellsCount))) * contrast)

    allCells(c + 1).Interior.TintAndShade = newContrast

    'control value- to delete
    allCells(c + 1).Offset(0, 1).Value = allCells(c + 1).Interior.TintAndShade
  Next

End Sub

什么是重要的 - 看看这一行：

    newContrast = (1 - 0.9 ^ (c * (1 + (c / allCellsCount))) * contrast)

在那里你可以做任何你想做的事，例如。变化：(1 + (c / allCellsCount))变成1到2之间的东西来理解逻辑的方式。通常，您可以通过操作此行来调整阴影更改的速度，尤其是使用这部分代码进行操作：(c * (1 + (c / allCellsCount))

于 2013-04-29T06:03:38.200 回答