Moderatori: Anthony47, Flash30005
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
CheckArea = " E3, E7, E11, E15,E19, E23, E27, E31, J5, J13, J21, J29, O9, O25"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If Selection.Rows.Count + Selection.Columns.Count > 2 Then Exit Sub
'...........................................
'If ActiveCell.FormulaR1C1 = "V" = 6 Then
'ActiveCell.FormulaR1C1 = "V" = xlNone
'Else
'ActiveCell.FormulaR1C1 = "V"
'End If
' Questo è il codice che sostituisce il tuo
If Target = "V" Then
Target = ""
Else
Target = "V"
End If
'...........................................
End If
Cancel = True
' .... altro tuo codice
' .... altro tuo codice
' .... altro tuo codice
End Sub
romeos ha scritto:Salve a tutti, all'interno di un foglio di lavoro ho una macro con all'interno questo frammento di codice:
....ma ho provato varie soluzioni e vista le mia scarsa conoscenza in VBA non ne vengo a capo.
If Selection.Rows.Count + Selection.Columns.Count > 2 Then Exit Sub
ricky53 ha scritto:Ciao,
immagino che il tuo codice sia inserito nell'evento "Doppio Click" !
romeos ha scritto:Ricky siete stati velocissimi nel rispondermi ed appena mi hai suggerito una soluzione ho cercato di ottimizzarla per le mie esigenze, ......
.....ma ho provato varie soluzioni e vista le mia scarsa conoscenza in VBA non ne vengo a capo
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckArea = " B3:D3, B7:D7,B11:D11,B15:D15,B19:D19,B23:D23,B27:D27,B31:D31,G5:I5,G13:I13,G21:I21,G29:I29,L9:N9,L25:N25"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
If ActiveCell.Interior.ColorIndex = 3 Then
ActiveCell.Interior.ColorIndex = xlNone
Else
ActiveCell.Interior.ColorIndex = 3
End If
End If
CheckArea = " A3, A7, A11, A15, A19, A23, A27, A31, F5, F13, F21, F29,K9, K25 "
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If ActiveCell.Interior.ColorIndex = 6 Then
ActiveCell.Interior.ColorIndex = xlNone
Else
ActiveCell.Interior.ColorIndex = 6
End If
End If
CheckArea = " E3, E7, E11, E15,E19, E23, E27, E31, J5, J13, J21, J29, O9, O25"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
' Questo è il codice che sostituisce il tuo (effetto interruttore)
If Target = "V" Then
Target = ""
Else
Target = "V"
End If
End If
Cancel = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckArea = " B3:D3, B7:D7,B11:D11,B15:D15,B19:D19,B23:D23,B27:D27,B31:D31,G5:I5,G13:I13,G21:I21,G29:I29,L9:N9,L25:N25"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
If ActiveCell.Interior.ColorIndex = 3 Then
ActiveCell.Interior.ColorIndex = xlNone
Else
ActiveCell.Interior.ColorIndex = 3
End If
End If
CheckArea = " A3, A7, A11, A15, A19, A23, A27, A31, F5, F13, F21, F29,K9, K25 "
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
If ActiveCell.Interior.ColorIndex = 6 Then
ActiveCell.Interior.ColorIndex = xlNone
Else
ActiveCell.Interior.ColorIndex = 6
End If
End If
CheckArea = " E3, E7, E11, E15,E19, E23, E27, E31, J5, J13, J21, J29, O9, O25"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
' Questo è il codice che sostituisce il tuo (effetto interruttore)
If Target = "V" Then
Target = ""
Else
Target = "V"
End If
End If
Cancel = True
End Sub
romeos ha scritto:ho provveduto così...
- Codice: Seleziona tutto
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckArea = " B3:D3, B7:D7,B11:D11,B15:D15,B19:D19,B23:D23,B27:D27,B31:D31,G5:I5,G13:I13,G21:I21,G29:I29,L9:N9,L25:N25"
......
CUT
.....
Cancel = True
End Sub
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 = "B3:D3, B7:D7,B11:D11,B15:D15,B19:D19,B23:D23,B27:D27,B31:D31,G5:I5,G13:I13,G21:I21,G29:I29,L9:N9,L25:N25"
CheckArea2 = "A3, A7, A11, A15, A19, A23, A27, A31, F5, F13, F21, F29,K9, K25 "
CheckArea3 = "E3, E7, E11, E15,E19, E23, E27, E31, J5, J13, J21, J29, O9, O25"
With Target
If Not Application.Intersect(Target, Me.Range(CheckArea1)) Is Nothing Then
If .Cells.Count > 1 Then Exit Sub
If .Interior.ColorIndex = 3 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 3
End If
bTarget = True
ElseIf Not Application.Intersect(Target, Range(CheckArea2)) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
If ActiveCell.Interior.ColorIndex = 6 Then
ActiveCell.Interior.ColorIndex = xlNone
Else
ActiveCell.Interior.ColorIndex = 6
End If
bTarget = True
ElseIf Not Application.Intersect(Target, Range(CheckArea3)) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
' Questo è il codice che sostituisce il tuo (effetto interruttore)
If Target = "V" Then
Target = ""
Else
Target = "V"
End If
bTarget = True
End If
If bTarget Then
Application.EnableEvents = False
Me.Range("A1").Select 'oppure .Offset(0, 1).Select
Application.EnableEvents = True
End If
End With
End Sub
scossa ha scritto:
Non vedendo il file e non potendo quindi sapere cosa c'è vado a naso, comunque cambierei il codice così:
- Codice: Seleziona tutto
CUT
With Target
If Not Application.Intersect(Target, Me.Range(CheckArea1)) Is Nothing Then
If .Cells.Count > 1 Then Exit Sub
....
CUT
End Sub
.....
With Target
If .Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Me.Range(CheckArea1)) Is Nothing Then
......
Torna a Applicazioni Office Windows
Inserimento parziale valore cella in MessageBox Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 6 |
Aggiornare cella con somma quando aggiungo nuova colonna Autore: marcopont |
Forum: Applicazioni Office Windows Risposte: 1 |
Visitano il forum: Nessuno e 11 ospiti