Moderatori: Anthony47, Flash30005
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 = "D6, F4, F12, H3, H7, H11, H15, J4, J12, L6"
CheckArea2 = "D14, F8, F16, H5, H9, H13, H17, J8, J16, L14"
CheckArea3 = "C6, C14, E4, E8, E12, E16, I3, I5, I7, I9, I11, I13, I15, I17, K4, K8, K12, K16, M6, M14 "
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
ElseIf 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
ElseIf Not Application.Intersect(Target, Range(CheckArea3)) Is Nothing Then
If Target = "V" Then
Target = ""
Else
Target = "V"
End If
bTarget = True
End If
If bTarget Then
Application.EnableEvents = False
Me.Range("G10").Select 'oppure .Offset(0, 1).Select
Application.EnableEvents = True
End If
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Stop '<< Qui!
Private Sub CommandButton7_Click()
'invia in premiazione archivia gara
'path premiazione gara
Dim riga As Long
Sheets("classificafemminile").Range(" A3:B16").Copy
With Workbooks("risultatikata.xls").Sheets("classificagara")
riga = .Range("E65536").End(xlUp).Row + 2
.Range("E" & riga).PasteSpecial Paste:=xlPasteValues
End With
'path premiazione campionato regionale
Sheets("classificafemminile").Range("B6:E9").Copy
With Workbooks("risultatikata.xls").Sheets("listaregfemminile")
riga = .Range("A65536").End(xlUp).Row + 2
.Range("A" & riga).PasteSpecial Paste:=xlPasteValues
End With
Sheets("classificafemminile").Range("B12:E15").Copy
With Workbooks("risultatikata.xls").Sheets("listaregfemminile")
riga = .Range("A65536").End(xlUp).Row + 2
.Range("A" & riga).PasteSpecial Paste:=xlPasteValues
End With
'salva e archivia gara
'da tabellonegara ad archiviagara
GCDir = "C:\Users\niko\Desktop\archiviagara\kata\femminili\"
TGDir = "C:\Users\niko\Desktop\tabellonigara\tabellonikata\femminili\"
'
ThisWorkbook.SaveAs (GCDir & ThisWorkbook.Name)
Kill (TGDir & ThisWorkbook.Name)
ThisWorkbook.Close
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'aumenta il valore della cella di 1
Application.EnableEvents = False
ind = Target.Address(RowAbsolute:=False, ColumnAbsolute:=False)
If ind = "H5" Then Range("H5") = Range("H5") + 1
Application.EnableEvents = True
End Sub
Le macro non sono nei fogli, ma nei moduli macro; puoi chiarire cosa intendi?in altro foglio ho questa semplicissima macro che funziona
Torna a Applicazioni Office Windows
Problema con macro copia e rinomina file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
PROBLEMA notebook hp con windows 11 audio sempre al massimo Autore: balza14 |
Forum: Audio/Video e masterizzazione Risposte: 13 |
Visitano il forum: raimea e 87 ospiti