Moderatori: Anthony47, Flash30005
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
Exit Sub
End If
If Target.Column = 1 Then
Dim UR As Long, Massimo As Integer
UR = Range("A" & Rows.Count).End(xlUp).Row
Application.EnableEvents = False
Massimo = Application.WorksheetFunction.Max(Range("A2:A" & UR - 1))
If Target.Value < Massimo Then
MsgBox "Il numero di protocollo inserito è minore di quelli esistenti", vbCritical
Target.Select
Exit Sub
End If
Application.EnableEvents = False
Cells(Target.Row, "B") = Date
Application.EnableEvents = True
End If
End Sub
Codice socio: J1; cella valorizzabile solo nel caso H1 sia D; ok
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
Exit Sub
End If
If Target.Column = 1 Then
Dim UR As Long, Massimo As Integer
UR = Range("A" & Rows.Count).End(xlUp).Row
' Application.EnableEvents = False ' <<===== CANCELLARE
Massimo = Application.WorksheetFunction.Max(Range("A2:A" & UR - 1))
If Target.Value < Massimo Then
MsgBox "Il numero di protocollo inserito è minore di quelli esistenti", vbCritical
Target.Select
Exit Sub
End If
Application.EnableEvents = False
Cells(Target.Row, "B") = Date
Application.EnableEvents = True
End If
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
Exit Sub
End If
If Target.Column = 2 Then
Dim UR As Long, Massimo As Integer
UR = Range("B" & Rows.Count).End(xlUp).Row
If UR = 2 Then
Range("A2") = 1
GoTo esci
End If
Massimo = Application.WorksheetFunction.Max(Range("A2:A" & UR - 1))
Application.EnableEvents = False
Cells(Target.Row, "A") = Massimo + 1
Application.EnableEvents = True
esci:
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
Dim UR As Long
UR = Range("B" & Rows.Count).End(xlUp).Row
If Target.Row > UR + 1 Or Target <> "" Then Exit Sub
Cells(Target.Row, "B") = Date
End If
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
Exit Sub
End If
If Target.Column = 1 Then
Dim UR As Long, Massimo As Integer
UR = Range("A" & Rows.Count).End(xlUp).Row
Massimo = Application.WorksheetFunction.Max(Range("A2:A" & UR - 1))
If Target.Value = "" And Target.Offset(0, 1) <> "" Then
MsgBox "Inserire un numero di protocollo", vbCritical
Target.Select
Exit Sub
End If
If Target.Value < Massimo Then
MsgBox "Il numero di protocollo inserito è minore di quelli esistenti", vbCritical
Target.Select
Exit Sub
Else
If Target.Value > Massimo + 1 Then
MsgBox "Il numero di protocollo digitato è diverso dal protocollo n. '" & Massimo + 1 & "' che va inserito !", vbCritical
Target.Select
Exit Sub
End If
End If
Application.EnableEvents = False
Cells(Target.Row, "B") = Date
Application.EnableEvents = True
Else
If Target.Column = 10 Then ' Colonna "J"
If Target.Offset(0, -2) = "" Then ' Colonna "H"
MsgBox "Se non è stato inserito il 'Destinatario' non si può inserire 'Copia Conoscenza'", vbCritical
Target.Select
Exit Sub
End If
End If
End If
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
Exit Sub
End If
If Target.Column = 1 Then
Dim UR As Long, Massimo As Integer
UR = Range("A" & Rows.Count).End(xlUp).Row
Massimo = Application.WorksheetFunction.Max(Range("A2:A" & UR - 1))
If Target.Value = "" And Target.Offset(0, 1) <> "" Then
MsgBox "Inserire un numero di protocollo", vbCritical
Target.Select
Exit Sub
End If
If Target.Value < Massimo Then
MsgBox "Il numero di protocollo inserito è minore di quelli esistenti", vbCritical
Target.Select
Exit Sub
Else
If Target.Value > Massimo + 1 Then
MsgBox "Il numero di protocollo digitato è diverso dal protocollo n. '" & Massimo + 1 & "' che va inserito !", vbCritical
Target.Select
Exit Sub
End If
End If
Application.EnableEvents = False
Cells(Target.Row, "B") = Date
Application.EnableEvents = True
Else
If Target.Column = 10 Then ' Colonna "J"
If Target <> "" And Target.Offset(0, -2) <> "D" Then ' Colonna "H"
MsgBox "Se non è stato inserito il 'Tipo=D' non si può inserire il 'Codice Socio'", vbCritical
Target.Select
Exit Sub
End If
End If
If Target.Column = 11 Then ' Colonna "K"
If Target.Offset(0, -2) = "" Then ' Colonna "I"
MsgBox "Se non è stato inserito il 'Destinatario' non si può inserire 'Copia Conoscenza'", vbCritical
Target.Select
Exit Sub
End If
End If
End If
End Sub
If Target.Value <= Massimo Then
MsgBox "Il numero di protocollo inserito è minore di quelli esistenti", vbCritical
Target.Select
Exit Sub
Else
If Target.Value > Massimo + 1 Then
MsgBox "Il numero di protocollo digitato è diverso dal protocollo n. '" & Massimo + 1 & "' che va inserito !", vbCritical
Target.Select
Exit Sub
End If
End If
If Target.Value <= Massimo Then
Torna a Applicazioni Office Windows
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Inserire dati filtrati da 2 file ad un terzo file Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 14 |
Supporto per sviluppo macro VBA Ordinare per data Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 3 |
Visitano il forum: Nessuno e 12 ospiti