Bur*_*ras 8 excel vba colors excel-vba
我需要编写一个宏:我用黑色填充A1.然后当我运行宏时,A2应该更轻一些,A3甚至更轻......等等,直到A20为白色."F5"单元格值应控制梯度指数的程度.当前代码按比例更改颜色.当我更改"F5"中的值(例如从1到0.7)时,会发生的是所有这20个单元格("A1:A20")变得非常暗.并且最后一个单元格A20不再是白色.
但是,我需要我的第一个单元格"A1"为黑色而最后一个单元格"A20"是白色的,无论是什么......而且,单元格的颜色分布应该是指数,即A1和A2之间的暗度差异应该是两倍(如果"F5"== 2)和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 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
Run Code Online (Sandbox Code Playgroud)
我无法弄清楚,我应该在上面实现什么功能,以便颜色的变化是指数级的,因为我contrast
在"F5"中更改了变量的值?// AND
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F5")) Is Nothing Then
Call Macro3
End If
End Sub
Run Code Online (Sandbox Code Playgroud)
你不能同时拥有"下一个细胞是白色的两倍"和"第一个细胞是黑色而最后一个细胞是白色的".您正在寻找的是一种称为"伽玛函数"的东西 - 从0到255的数字缩放程度,它们变亮的速率取决于一个因子(有时称为伽玛).
在其基本形式中,您可以使用以下内容:
contrast = ((cellNum-1)/(numCells-1))^gamma
Run Code Online (Sandbox Code Playgroud)
现在,如果您的伽玛值为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
Run Code Online (Sandbox Code Playgroud)
和
Sub adjustContrast(gamma)
... etc
Run Code Online (Sandbox Code Playgroud)
由于您的评论中很明显我在原始帖子中不够明确,这里是完整的代码,以及它给我的结果.注意 - 这是用于演示在显示器上更改gamma的效果的代码,而不是您要使用的确切代码(例如,I循环四列并具有四个不同的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
Run Code Online (Sandbox Code Playgroud)
在运行代码之前,我的屏幕看起来像这样(单元格中的值是给定gamma的计算对比度值):
运行后,它看起来像这样:
正如您所看到的,我添加了一个额外的"功能":更改字体的颜色以使事物可见.当然,这假定"模板单元"(在我的情况下A1
)在字体和填充颜色之间具有良好的对比度.
归档时间: |
|
查看次数: |
1209 次 |
最近记录: |