ho un frammento di codice ricavato con il costro aiuto, che per anni ha svolto egregiamente il suo compito, ma che necessariamente devo implementare,il problema concreto e che il codice mi effettua una sorta di interruttore con "ON" la cella che seleziono e rimandadomi a "OFF" sulla cella D14
- Codice: Seleziona tutto
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CheckArea1 As String
Dim CheckArea2 As String
Dim CheckArea3 As String
Dim bTarget As Boolean
CheckArea1 = "c2,c4,c6,c8,c10"
CheckArea2 = "c12,c14,c16,c18,c20"
CheckArea3 = "c24,c26,c28,c30,c32"
With Target
If .Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Range(CheckArea1)) Is Nothing Then
If ActiveCell.Interior.ColorIndex = 3 Then
.Font.ColorIndex = 1
ActiveCell.Interior.ColorIndex = xlNone
Else
ActiveCell.Interior.ColorIndex = 3
.Font.ColorIndex = 2
End If
bTarget = True
End If
If Not Application.Intersect(Target, Range(CheckArea2)) Is Nothing Then
If ActiveCell.Interior.ColorIndex = 5 Then
.Font.ColorIndex = 1
ActiveCell.Interior.ColorIndex = xlNone
Else
ActiveCell.Interior.ColorIndex = 5
.Font.ColorIndex = 2
End If
bTarget = True
End If
If Not Application.Intersect(Target, Range(CheckArea3)) Is Nothing Then
If ActiveCell.Interior.ColorIndex = 8 Then
.Font.ColorIndex = 1
ActiveCell.Interior.ColorIndex = xlNone
Else
ActiveCell.Interior.ColorIndex = 8
.Font.ColorIndex = 2
End If
bTarget = True
End If
If bTarget Then
Application.EnableEvents = False
Me.Range("D15").Select 'oppure .Offset(0, 1).Select
Application.EnableEvents = True
End If
End With
End Sub
ora avrei la necessita che "OFF" mi rimandi ad una cella differente, univoca, per ogni colore per esempio CheckArea1 "D6",CheckArea2 "D15",CheckArea3 "D28".Grazie in anticipo per l'aiuto e l'attenzione che vorrete offrirmi.