As always, post YOUR code for comments and suggestions.- Nascondi testo citato
- Mostra testo citato -
Thank you for your interest. I just didn't want to annoy you with the
whole code.
Once again: I insert a date in column E and the macro inserts some
data based on the date in other cells on the same row.
It works fine but if I want to autofill many cells in column E with
the same date by dragging the black cross on the right of the cell the
Worksheet_Change macro doesn't work.
Thanks again for your help!
Tina
Here's the code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E:E")) Is Nothing Then
'a)controlla che la data inserita non sia inferiore a quella
precedente (ev. aggiungere altri ctrl plausib ?)
data = Target.Offset(-1, 0)
If Target.Value < data Then
MsgBox "data errata", vbOKOnly
With Target
..Select
..Value = ""
End With
End If
'b)se la data è il 1° lunedì colora la cella d'arancione, di giallo
ogni data del primo pz di un nuovo giorno
datalun = Weekday(Target, vbMonday)
If datalun = 1 Then
'se è il primo lunedì dopo una data precedente (altrimenti tutti i
lun. sono arancioni)
If Target > data Then
With Target.Offset.Interior
..ColorIndex = 45
..Pattern = xlSolid
End With
End If
End If
datalunprec = Weekday(Target.Offset(-1, 0), vbMonday)
If datalunprec < datalun Then
With Target.Offset.Interior
..ColorIndex = 27
..Pattern = xlSolid
End With
End If
'c)all'inserim. della data riempie gg in numerico e lettere,
settimana, mese, trim., sem. e anno
'c1) giorno numerico
Target.Offset(0, 21) = datalun
'c2) giorno lettere
'in alterntiva si potrebbe fare: Target.Offset(0, 21) = WeekdayName(1,
False, vbMonday)
Select Case datalun
Case "1"
Target.Offset(0, 22) = "Lunedì"
Case "2"
Target.Offset(0, 22) = "Martedì"
Case "3"
Target.Offset(0, 22) = "Mercoledì"
Case "4"
Target.Offset(0, 22) = "Giovedì"
Case "5"
Target.Offset(0, 22) = "Venerdì"
Case "6"
Target.Offset(0, 22) = "Sabato"
Case "7"
Target.Offset(0, 22) = "Domenica"
End Select
'c3)nr settimana
With Target.Offset(0, 23)
..FormulaR1C1 = "=WEEKNUM(RC[-23],2)-1"
'trasforma la formula in valore
..Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
End With
Target.Offset(0, 1).Select
'c4)mese
mese = Mid(Target, 4, 2)
Target.Offset(0, 24) = mese
'c5 mese in lettere
Select Case mese
Case "1"
Target.Offset(0, 25) = "Gennaio"
Case "2"
Target.Offset(0, 25) = "Febbraio"
Case "3"
Target.Offset(0, 25) = "Marzo"
Case "4"
Target.Offset(0, 25) = "Aprile"
Case "5"
Target.Offset(0, 25) = "Maggio"
Case "6"
Target.Offset(0, 25) = "Giugno"
Case "7"
Target.Offset(0, 25) = "Luglio"
Case "8"
Target.Offset(0, 25) = "Agosto"
Case "9"
Target.Offset(0, 25) = "Settembre"
Case "10"
Target.Offset(0, 25) = "Ottobre"
Case "11"
Target.Offset(0, 25) = "Novembre"
Case "12"
Target.Offset(0, 25) = "Dicembre"
End Select
'c6) trimestri
Select Case mese
Case "01", "02", "03"
Target.Offset(0, 26) = "1°" & " trim."
Case "04", "05", "06"
Target.Offset(0, 26) = "2°" & " trim."
Case "07", "08", "09"
Target.Offset(0, 26) = "3°" & " trim."
Case "10", "11", "12"
Target.Offset(0, 26) = "4°" & " trim."
End Select
'c7) semestri
Select Case mese
Case "01", "02", "03", "04", "05", "06"
Target.Offset(0, 27) = "1°" & " sem."
Case "07", "08", "09", "10", "11", "12"
Target.Offset(0, 27) = "2°" & " sem."
End Select
'c8) anno
Target.Offset(0, 28) = Right(Target, 4)
'scendi di una cella
Target.Offset(1, 0).Select
End If
End Sub