Moderatori: Anthony47, Flash30005
Private Sub HighlightSeries(ByVal x As Long, ByVal y As Long)
Dim ElementID As Long
Dim Arg1 As Long
Dim Arg2 As Long
Dim Evidenz As Integer
Me.GetChartElement x, y, ElementID, Arg1, Arg2
If ElementID = xlLegendEntry Or ElementID = xlLegendKey Then
If miSeries <> Arg1 Then
' ResetSeries
With Me.Legend.LegendEntries(Arg1)
With .LegendKey.Border
If .Weight = xlMedium Then
Evidenz = 1
.Weight = xlHairline
.LineStyle = xlDot
Else:
.Weight = xlMedium
.LineStyle = xlContinuous
Evidenz = 0
End If
End With
With .Font
If Evidenz = 1 Then
.ColorIndex = xlAutomatic
.Background = xlTransparent
.FontStyle = "Regular"
Else:
.ColorIndex = iCOLOR_HIGHLIGHT
.Background = xlTransparent
.FontStyle = "Bold"
End If
End With
End With
miSeries = Arg1
End If
End If
End Sub
=SE(CERCA.VERT($A2;master;2;0)>0;A2;NON.DISP())
Sub nascondi()
Dim MySeries As Series
For Each MySeries In ActiveChart.SeriesCollection
If Left(MySeries.Name, 2) = "PI" Then
ActiveChart.SeriesCollection(MySeries.Name).IsFiltered = True
End If
Next MySeries
End Sub
Sub mostra()
Dim MySeries As Series
For Each MySeries In ActiveChart.SeriesCollection
ActiveChart.SeriesCollection(MySeries.Name).IsFiltered = False
Next MySeries
End Sub
Option Explicit
'Const iCOLOR_HIGHLIGHT As Long = 5 ' BLUE <== riga eliminata
'Const iCOLOR_BLAND As Long = 15 ' 25% GRAY >== riga eliminata
Private miSeries As Long
Private Sub Chart_Activate()
ResetSeries
End Sub
Private Sub Chart_MouseDown(ByVal Button As Long, ByVal Shift As Long, _
ByVal x As Long, ByVal y As Long)
HighlightSeries x, y
End Sub
Private Sub Chart_MouseMove(ByVal Button As Long, ByVal Shift As Long, _
ByVal x As Long, ByVal y As Long)
HighlightSeries x, y
End Sub
Private Sub HighlightSeries(ByVal x As Long, ByVal y As Long)
Dim ElementID As Long
Dim Arg1 As Long
Dim Arg2 As Long
Me.GetChartElement x, y, ElementID, Arg1, Arg2
If ElementID = xlLegendEntry Or ElementID = xlLegendKey Then
If miSeries <> Arg1 Then
ResetSeries
With Me.Legend.LegendEntries(Arg1)
With .Font
' .ColorIndex = iCOLOR_HIGHLIGHT <== riga eliminata
.Background = xlTransparent
.FontStyle = "Bold"
End With
With .LegendKey.Border
' .ColorIndex = iCOLOR_HIGHLIGHT <== riga eliminata
.Weight = xlThick 'xlMedium <========= riga modificata
.LineStyle = xlContinuous
End With
End With
miSeries = Arg1
End If
End If
End Sub
Private Sub ResetSeries()
Dim lgnd As LegendEntry
Application.ScreenUpdating = False
For Each lgnd In Me.Legend.LegendEntries
With lgnd.Font
.ColorIndex = xlAutomatic
.Background = xlTransparent
.FontStyle = "Regular"
End With
With lgnd.LegendKey.Border
'.ColorIndex = iCOLOR_BLAND <== riga eliminata
.Weight = xlThin
.LineStyle = xlContinuous
End With
Next
Application.ScreenUpdating = True
End Sub
Sub OnOff()
'
ActiveSheet.ChartObjects(1).Activate '<<< Il vero Indice del grafico
For i = 1 To ActiveChart.SeriesCollection.Count
srcform = ActiveChart.SeriesCollection(i).Formula '.Values '= "=Foglio1!$C$2:$E$2"
mysplit = Split(srcform, "(", , vbTextCompare)
If UBound(mysplit) > 0 Then
mysplit = Split(mysplit(1), "!", , vbTextCompare)
If UBound(mysplit) > 0 Then
myvl = Application.VLookup(Sheets(mysplit(0)).Range(Split(mysplit(1), ",", , vbTextCompare)(0)).Offset(0, -1).Value, Range("master"), 2, 0)
If Not IsError(myvl) Then
If myvl <> 1 Then 'Categoria della serie e' in tabella:
ActiveChart.SeriesCollection(i).Format.Line.Visible = msoFalse
Else
ActiveChart.SeriesCollection(i).Format.Line.Visible = msoTrue
End If
Else 'Categoria della serie non in Tabella:
ActiveChart.SeriesCollection(i).Format.Line.Visible = msoTrue
End If
End If
End If
Next i
Range("A1").Select
End Sub
Sub OnOff2()
'
ActiveSheet.ChartObjects(1).Activate '<<< Il vero Indice del grafico
For i = 1 To ActiveChart.FullSeriesCollection.Count
srcform = ActiveChart.FullSeriesCollection(i).Formula
mysplit = Split(srcform, "(", , vbTextCompare)
If UBound(mysplit) > 0 Then
mysplit = Split(mysplit(1), "!", , vbTextCompare)
If UBound(mysplit) > 0 Then
myvl = Application.VLookup(Sheets(mysplit(0)).Range(Split(mysplit(1), ",", , vbTextCompare)(0)).Offset(0, -1).Value, Range("master"), 2, 0)
If Not IsError(myvl) Then
If myvl <> 1 Then 'Categoria della serie e' in tabella:
ActiveChart.FullSeriesCollection(i).IsFiltered = True
Else
ActiveChart.FullSeriesCollection(i).IsFiltered = False
End If
Else 'Categoria della serie non in Tabella:
ActiveChart.FullSeriesCollection(i).IsFiltered = False
End If
End If
End If
Next i
Range("A1").Select
End Sub
Sub prova_convalida() 'mostra solo quella selezionata
Dim cht As Chart
Dim ser As Series
Dim slz As String
Dim num As Integer
Dim i As Long
slz = Range("J5").Value: If slz = "" Then Exit Sub
'rimanda al select case
num = selcase(slz)
Set cht = Worksheets("Foglio1").ChartObjects("Grafico 2").Chart
If num = 0 Then
For i = 1 To cht.SeriesCollection.Count
Set ser = cht.SeriesCollection(i)
With ser.Format.Line
.Visible = msoTrue
End With
Next i
ElseIf num > 0 Then
For i = 1 To cht.SeriesCollection.Count
Set ser = cht.SeriesCollection(i)
With ser.Format.Line
.Visible = msoFalse
End With
Next i
Set ser = cht.SeriesCollection(num)
With ser.Format.Line
.Visible = msoTrue
End With
End If
End Sub
Function selcase(ByVal slz As String) As Integer
Dim num As Integer
Select Case slz
Case "serie tutte"
num = 0
Case "serie a"
num = 1
Case "serie b"
num = 2
Case "serie c"
num = 3
Case "serie d"
num = 4
Case "serie e"
num = 5
Case "serie f"
num = 6
End Select
selcase = num
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J5")) Is Nothing Then
Call prova_convalida
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B7")) Is Nothing Then
Call OnOff3
End If
End Sub
Sub OnOff3()
On Error Resume Next
For j = 2 To 11
Sheets(j).Activate '<<< Il vero Indice del grafico
For i = 1 To ActiveChart.FullSeriesCollection.Count
srcform = ActiveChart.FullSeriesCollection(i).Formula
If InStr(1, srcform, "xls") Then
GoTo continua
End If
mysplit = Split(srcform, ",", , vbTextCompare)
If UBound(mysplit) > 0 Then
mysplit = Split(mysplit(1), "!", , vbTextCompare)
If UBound(mysplit) > 0 Then
foglio = Replace(mysplit(0), "'", "")
myvl = Application.VLookup(Sheets(foglio).Cells(1, 1).Value, Range("master"), 2, 0)
If Not IsError(myvl) Then
If myvl <> 1 Then 'Categoria della serie e' in tabella:
ActiveChart.FullSeriesCollection(i).IsFiltered = True
Else
ActiveChart.FullSeriesCollection(i).IsFiltered = False
End If
Else 'Categoria della serie non in Tabella:
ActiveChart.FullSeriesCollection(i).IsFiltered = False
End If
End If
End If
continua:
Next i
Next j
Worksheets(1).Activate
Range("A1").Select
End Sub
Torna a Applicazioni Office Windows
Inserire dati filtrati da 2 file ad un terzo file Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 14 |
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
Visitano il forum: Nessuno e 14 ospiti