|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 黑山上的鹰 于 2023-6-5 09:07 编辑
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim chtchart As Chart
Dim rngrange As Range, ingrow As Long
Set rngrange = Application.Intersect(ActiveCell, Me.Range("e85:i110"))
If Not rngrange Is Nothing Then
lngrow = ActiveCell.Row
Set chtchart = Me.ChartObjects(9).Chart
chtchart.SeriesCollection(1).Values = Me.Range("e" & lngrow, "i" & lngrow)
chtchart.ChartTitle.Text = Range("c" & lngrow).Value
End If
Set rngrange = Nothing
Set chtchart = Nothing
Dim chtchart1 As Chart
Dim rngrange1 As Range, ingrow1 As Long
Set rngrange1 = Application.Intersect(ActiveCell, Me.Range("e6:i26"))
If Not rngrange1 Is Nothing Then
lngrow1 = ActiveCell.Row
Set chtchart1 = Me.ChartObjects(8).Chart
chtchart1.SeriesCollection(1).Values = Me.Range("e" & lngrow1, "i" & lngrow1)
End If
Set rngrange1 = Nothing
Set chtchart1 = Nothing
If Target.Column > 4 And Target.Column < 10 Then
Dim chtchart2 As Chart, chtchart3 As Chart '饼图
Set chtchart2 = Me.ChartObjects(10).Chart '饼图
Set chtchart3 = Me.ChartObjects(11).Chart '饼图
If Target.Row >= 6 And Target.Row <= 8 Then
Range("o6") = Range("c6") & Range("d" & ActiveCell.Row) & "成本对比图"
Range("o6").Replace "小计", ""
chtchart2.SeriesCollection(1).Values = Range("H6:H7") '饼图
chtchart3.SeriesCollection(1).Values = Range("I6:I7") '饼图
End If
If Target.Row >= 9 And Target.Row <= 11 Then
Range("o6") = Range("c9") & Range("d" & ActiveCell.Row) & "成本对比图"
chtchart2.SeriesCollection(1).Values = Range("H9:H10") '饼图
chtchart3.SeriesCollection(1).Values = Range("i9:i10") '饼图
End If
If Target.Row >= 12 And Target.Row <= 14 Then
Range("o6") = Range("c12") & Range("d" & ActiveCell.Row) & "成本对比图"
chtchart2.SeriesCollection(1).Values = Range("H12:H13") '饼图
chtchart3.SeriesCollection(1).Values = Range("i12:i13") '饼图
End If
If Target.Row >= 15 And Target.Row <= 17 Then
Range("o6") = Range("c15") & Range("d" & ActiveCell.Row) & "成本对比图"
chtchart2.SeriesCollection(1).Values = Range("H15:H16") '饼图
chtchart3.SeriesCollection(1).Values = Range("i15:i16") '饼图
End If
If Target.Row >= 18 And Target.Row <= 20 Then
Range("o6") = Range("c18") & Range("d" & ActiveCell.Row) & "成本对比图"
chtchart2.SeriesCollection(1).Values = Range("H18:H19") '饼图
chtchart3.SeriesCollection(1).Values = Range("i18:i19") '饼图
End If
If Target.Row >= 21 And Target.Row <= 23 Then
Range("o6") = Range("c21") & Range("d" & ActiveCell.Row) & "成本对比图"
chtchart2.SeriesCollection(1).Values = Range("H21:H22") '饼图
chtchart3.SeriesCollection(1).Values = Range("i21:i22") '饼图
End If
If Target.Row >= 24 And Target.Row <= 26 Then
Range("o6") = Range("c24") & Range("d" & ActiveCell.Row) & "成本对比图"
chtchart2.SeriesCollection(1).Values = Range("H24:H25") '饼图
chtchart3.SeriesCollection(1).Values = Range("i24:i25") '饼图
End If
Range("o6").Replace "小计", ""
End If
End Sub
各位老师:请教一下,运行时错误:2147024809(80070057)该对象无标题,怎么解?谢谢!
|
|