Lun*_*tik 1 excel charts vba excel-vba
我想在表格中概述图表数据范围源,就像在点击图表数据系列时GUI将以蓝色勾勒出一个范围的方式非常相似.用户可以选择各种图表视图,每个数据系列的范围突出显示颜色需要与图表中显示的颜色相匹配.
为了记录,以下是我考虑的方法:
最后,我使用选项2,因为它似乎更容易实现并且正确管理颜色,我可能必须将它们存储在方法1中,否则它的好处.
从Worksheet_Change事件中调用突出显示过程,对图表名称进行查找,从表中提取范围和颜色,然后执行单元格格式化.此方法的局限性在于必须预先计算每个新图表视图的范围/颜色数据.这对我当前的实现来说并不是什么大问题,但是我将成为未来使用中的限制因素,其中图表可能更具动态性.
所以虽然我有一个这个工作正常的版本,我敢肯定必须有一个更优雅的方式来实现这一点.
有什么建议?
编辑:
好的,这似乎可以更好地处理更多案例.触发代码是相同的,但这里是模块的新代码:
Function SeriesRange(s As Series) As Range
Dim sf As String, fa() As String
sf = s.Formula
sf = Replace(sf, "=SERIES(", "")
If sf = "" Then
Set SeriesRange = Nothing
Exit Function
End If
fa = Split(sf, ",")
Set SeriesRange = Range(fa(2))
End Function
Sub x(c As Chart)
Dim sc As Series
Dim sr As Range
If SeriesRange(c.SeriesCollection(1)) Is Nothing Then
Exit Sub
End If
Set sr = SeriesRange(c.SeriesCollection(1))
sr.CurrentRegion.Interior.ColorIndex = xlNone
For Each sc In c.SeriesCollection
If sc.Interior.Color > 1 Then
SeriesRange(sc).Interior.Color = sc.Interior.Color
ElseIf sc.Border.ColorIndex > 1 Then
SeriesRange(sc).Interior.Color = sc.Border.Color
ElseIf sc.MarkerBackgroundColorIndex > 1 And sc.MarkerBackgroundColorIndex < 57 Then
SeriesRange(sc).Interior.ColorIndex = sc.MarkerBackgroundColorIndex
ElseIf sc.MarkerForegroundColorIndex > 1 And sc.MarkerForegroundColorIndex < 57 Then
SeriesRange(sc).Interior.ColorIndex = sc.MarkerForegroundColorIndex
Else
MsgBox "Unable to determine chart color for data series " & sc.Name & " ." & vbCrLf _
& "It may help to assign a color rather than allowing AutoColor to assign one."
End If
Next sc
End Sub
Run Code Online (Sandbox Code Playgroud)
/编辑
这可能比优雅更野蛮,但我认为它符合你的要求.它涉及您的第一个项目符号点以获取Series对象的范围,以及一个子项来遍历图表Series中的所有对象SeriesCollection.这是激活的Chart_DeActivate.这些代码大部分都被顶起 - 请参阅消息来源评论.
在一个模块中:
Function SeriesRange(s As Series) As Range
Dim sf As String, fa() As String
Dim i As Integer
Dim result As Range
sf = s.Formula
sf = Replace(sf, "=SERIES(", "")
fa = Split(sf, ",")
Set SeriesRange = Range(fa(2))
End Function
Sub x(c As Chart)
Dim sc As Series
Dim sr As Range
Set sr = SeriesRange(c.SeriesCollection(1))
sr.CurrentRegion.Interior.ColorIndex = xlNone
For Each sc In c.SeriesCollection
SeriesRange(sc).Interior.Color = sc.Interior.Color
Next sc
End Sub
Run Code Online (Sandbox Code Playgroud)
在ThisWorkbook对象模块中:
' Jacked from C Pearson http://www.cpearson.com/excel/Events.aspx '
Public WithEvents CHT As Chart
Private Sub CHT_Deactivate()
x CHT
End Sub
Private Sub Workbook_Open()
Set CHT = Worksheets(1).ChartObjects(1).Chart
End Sub
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
3680 次 |
| 最近记录: |