Εμφάνιση ενός μόνο μηνύματος
  #7  
Παλιά 05-03-14, 21:16
anestaki Ο χρήστης anestaki δεν είναι συνδεδεμένος
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 05-02-2010
Μηνύματα: 196
Προεπιλογή S.O.S ακόμη παιδεύομαι

Καλησπέρα σε όλους
Κώδικας:
 
Private Sub CommandButton2_Click()
If ComboBox4.Value = "" Then
MsgBox "Δεν είναι συμπληρωμένος ο μηνάς"
Exit Sub
End If
If Range("MonthList") = ComboBox4.Value & "-" & Year(Now()) Then
‘εδώ μου κολλάει και δεν μπορώ να καταλάβω γιατί
MsgBox "O μηνάς" & ComboBox4.Value & " για το " & Year(Now()) & "υπαρχή"
Exit Sub
End If
On Error Resume Next
Dim c As Range, i As Long, e As Range
i = kinisis.Cells(Rows.Count, 2).End(xlUp).Row
For Each c In pelates.Range("pelatis").Columns(0).Cells
‘pelates.Range("pelatis").Columns(0).Cells  αυτό πως μπορώ να αντικαταστήσω με το ‘αντίστοιχο της λίστα (Listbox1) που υπαρχή στην φόρμα. 
 If c.Offset(, 11).Value = True Then
‘μου αφήνει μια κενή γραμμή
For Each e In diaxiristis.Range("diaxiristis").Columns(1).Cells(c)
         kinisis.Range("a" & i + c).Value = i + c - 1
         kinisis.Range("B" & i + c).Value = c.Offset(, 0).Value
         kinisis.Range("c" & i + c).Value = c.Offset(, 1).Value
If c.Offset(, 0).Value = e.Offset(, 1).Value And e.Offset(, 7).Value = True Then
‘δεν μου εμφανίζει  της σωστές έγραφες.
         kinisis.Range("d" & i + c).Value = e.Offset(, 0).Value
         kinisis.Range("e" & i + c).Value = ComboBox4.Value
         kinisis.Range("f" & i + c).Value = c.Offset(, 7).Value
         kinisis.Range("g" & i + c).Value = c.Offset(, 9).Value
         kinisis.Range("h" & i + c).Value = DtpDate.Value
         kinisis.Range("i" & i + c).Value = Year(Now())
         If CheckBox1.Value = True Then
         kinisis.Range("j" & i + c) = CheckBox1.Value
         Else
         kinisis.Range("j" & i + c) = False
         kinisis.Range("m" & i + 1) = ComboBox4.Value & "-" & Year(Now())
     ThisWorkbook.Names.Add "MonthList", kinisis.Range("m2:m" & i + 1)
End If
Next
End If
Next 
End Sub 
Συνημμένα Αρχεία
Τύπος Αρχείου: xlsm PELATESTEST1-2.xlsm (65,0 KB, 38 εμφανίσεις)

Τελευταία επεξεργασία από το χρήστη anestaki : 08-03-14 στις 13:26.
Απάντηση με παράθεση