Πρόβλημα με κώδικα VBA

[γιώργοςΚ]

Χιαρετώ όλους τους φίλους στο φόρουμ,

Παραθέτω πιο κάτω έναν κώδικα το οποίο έχω γράψει έτσι ώστε να μπορεί να γίνεται η καταχώρηση κάποιων δεδομένων σε ένα πίνακα αλλά δυστυχώς όσο και να έχω προσπαθήσει δεν έχω καταφέρει να καταλάβω τι συμβαίνει και δεν δουλεύει όπως θα έπρεπε. Παρακαλώ σημειώστε ότι οι γνώσεις μου σε Vba είναι από το κάτι έως το άσχετος..

Λοιπόν, στην πιο κάτω διαδικασία εφόσον ισχύει η πρώτη περίπτωση όπου δηλαδή το πεδίο "SVN1" είναι κενό, να μπορεί πατώντας το command AddPc να καταχωρεί στον πίνακα tblLogin και στο πεδίο SVN1 την συγκεκριμένη τιμή απο τον tblLogSVN.

Στην συνέχεια, εάν όμως δεν ισχύει η πρώτη περίπτωση (όπου δηλαδή SVN1 = Null) θα πρέπει να πατώντας το AddPc να καταχωρεί την τιμή του SVN2 εφόσον ισχύει η δεύτερη παράμετρος όπου δηλαδή το SVN1 δεν είναι κενό ή έχει τιμή μεγαλύτερη απο 1.

Έχω δοκιμάσει όλες τις εκδοχές αλλά δυστυχώς δεν έχω καταφέρει να βρώ την λύση στο πρόβλημα και έστι ο κώδικας είτε σταματά στο πρώτο σκέλος της διαδικασίας είτε δεν μπορεί να προχωρήσει στο δεύτερο σκέλος.

Σας ευχαριστώ εκ προτέρων



Private Sub cmdAddPc_Click()

If IsNull(Me.SVN1) Or Me.SVN1 = "" Then
MsgBox "Message SVN1.!!", vbInformation, "Warning 1"
Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("SELECT TOP 2 SVNnumber FROM tblLogSVN")
If rs.RecordCount Then
rs.MoveFirst
Me.SVN1 = rs!SVNnumber
Me.Pc1 = True
Else

If Not IsNull(Me.SVN1) Or Me.SVN1 > 1 Then
MsgBox "Message SVN2.!!", vbInformation, "Warning 2"
Set rs = CurrentDb.OpenRecordset("SELECT TOP 2 SVNnumber FROM tblLogSVN")
If rs.RecordCount Then
rs.MoveNext
Me.SVN2 = rs!SVNnumber
Me.Pc2 = True

End If
End If
End If
End If
End Sub

[Meteora]

Γιώργη, δοκίμασε κάτι σαν αυτό...

Private Sub cmdAddPc_Click()
Dim rs As DAO.Recordset
  Set rs = CurrentDb.OpenRecordset("SELECT TOP 2 SVNnumber FROM tblLogSVN")
If rs.RecordCount =0 Then exit sub   
  select case True
      case  IsNull(Me.SVN1) Or Me.SVN1 = ""
               Me.SVN1 = rs!SVNnumber :  Me.Pc1 = True
               MsgBox "Message SVN1.!!", vbInformation, "Warning 1"
      case  2η συνθήκη
               < κάνε ότι λέει κώδικας ...»
      case else
               <αν δεν ισχύουν οι συνθήκες 1η και 2η, κάνε τα εξής...>
  End select
  End Sub

Ελπίζω να τα καταφέρεις. Γενικά δεν πρέπει να δουλεύεις με περισσότερα από ένα if...else...end if

Με εκτίμηση
Νίκος

[γιώργοςΚ]

Καλησπέρα φίλε Νίκο,

Κατά αρχάς σε ευχαριστώ πολύ φίλε μου για την βοήθεια. Δεν έχω ξαναδουλέψει με το Case άρα δεν έχω και την ανάλογη εμπερία περί τούτου. Παρόλα αυτά θα προσπαθήσω να προσαρμόσω τον κώδικα σου στην βάση μου και εάν και εφόσον παραστεί αναγκαίο θα επανέλθω.

Σε κάθε περίπτωση σε ευχαριστώ και πάλι πάρα πολύ.

[γιώργοςΚ]

Νίκο γειά σου και πάλι,

Έχω προσαρμώσει τον κώδικα ώς παρουσιάζεται πάρα κάτω αλλά φίλε θέλω να σταματά η διαδικασία εφόσον ισχύει το ένα απο τα δύο σενάρια.

Στον κώδικα όπως τον διαμόρφωσα και πάλι εξακολουθεί εφόσον πατήσω μια φορά το command AddPc να βάζει αφενός μέν την πρώτη φορά την πρώτη εγραφή, και αφετέρου εάν ξαναπατήσεις το command προχωρά και βάζει και την δεύτερη εφόσον τα κριτήρια που θέλω ισχύουν και πάλι (εφόσον πλέον το SVN1 δεν είναι κενό και έχει τιμή μεγαλύτερη του >1)

Το ζητούμενο είναι να γίνεται disable το command έτσι ώστε μια φορά να μπορεί να λειτουργήσει εφόσον εάν ο κώδικας "τρέξει" για το Case 1 ισχύουν τα δεδομένα, και εφόσον ενημερωθεί ο πίνακας το SVN1 μεταβάλλεται σε Not Null και >1 και έτσι εάν επιχειρήσει κάποιος απο λάθος να πατήσει ξανά το command συνεχίζει (και καλά το κάνει) να τρέχει και το δεύτερο σκέλος του κώδικα.

Παραθέτω το κώδικα όπως τον μετέτρεψα:

Private Sub cmdAddPc_Click()

Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("SELECT TOP 2 SVNnumber FROM tblLogSVN")
If rs.RecordCount = 0 Then Exit Sub

Select Case True

Case IsNull(Me.SVN1) Or Me.SVN1 = ""
Me.SVN1 = rs!SVNnumber: Me.Pc1 = True
MsgBox "Message SVN1.!!", vbInformation, "Warning 1"


Case Not IsNull(Me.SVN1) Or Me.SVN1 > 1
rs.MoveNext
Me.SVN2 = rs!SVNnumber
Me.Pc2 = True

' Case Else


End Select
End Sub

[Meteora]

Εσύ ξέρεις τι σχεδιάζεις και εσύ θα βρεις λύση. Εγώ είδα εκείνους τους βρόχους των τεσσάρων if...else...end if και ...έδωσα χέρι βοήθειας.
Ήδη έχεις σκέψεις ( ...disable το κουμπί command... ), οπότε καλή συνέχεια Γιώργη...

Με εκτίμηση
Νίκος

[kapetang]

Καλησπέρα

Χωρίς να είμαι σίγουρος ότι κατάλαβα το ζητούμενο, προτείνω να δοκιμάσεις και τον παρακάτω κώδικα:

Private Sub cmdAddPc_Click()
    Dim rs As DAO.Recordset

    Set rs = CurrentDb.OpenRecordset("SELECT TOP 2 SVNnumber FROM tblLogSVN")
    rs.MoveLast
    If rs.RecordCount Then
        If Nz(Me.SVN1, "") = "" Then
            rs.MoveFirst
            Me.SVN1 = rs!SVNnumber
            Me.Pc1 = True
        End If
        If Nz(Me.SVN2, "") = "" And rs.RecordCount > 1 Then
            rs.MoveLast
            Me.SVN2 = rs!SVNnumber
            Me.Pc2 = True
        End If
    End If
End Sub

Ίσως να μάντεψα σωστά.

Φιλικά/Γιώργος

[γιώργοςΚ]

Καλημέρα Γιώργο,

¨Εχω δοκιμάσει τον κώδικα που μου έδωσες αλλά και πάλιν δυστυχώς δεν έφτασα στο ζητούμενο. Επειδή αντιλαμβάνομαι ότι μπορεί να σας έχω κάπως συγχίσει με το ζητούμενο, επισυνάπτω ένα παράδειγμα στο οποίο συμπεριλαμβάνω οδηγίες χρήσης έτσι ώστε να μπορέσουμε να φτάσουμε στο ζητούμενο.

Θα εκτιμούσα εάν μπορούσε κάποιος φίλος απο το forum μας να "δωσει" τα φώτα του καθώς όπως προανάφερα "υστερώ" απο πλευράς γνώσεων vba.

Σας ευχαριστώ εκ προτέρων και είμαι στην διάθεση σας για οποιαδήποτε διευκρίνηση

[kapetang]

Καλησπέρα

Γιώργο δοκίμασε και το εξής:

Χωρίς καμιά άλλη αλλαγή στον κώδικα του προηγούμενου μηνύματός μου πρόσθεσε την εντολή Exit Sub ακριβώς κάτω από τη γραμμή Me.Pc1=True.

[γιώργοςΚ]

Καλησπέρα Γιώργο,

Επειδή ο κώδικας που μου έστειλες δεν δούλεψε κανονικά σε ότι αφορά το δεύτερο σκέλος του, το άφησα σε:

Private Sub cmdAddPc_Click()

If IsNull(Me.SVN1) Or Me.SVN1 = "" Then
MsgBox "SVN1.!!", vbInformation, "Warning"
Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("SELECT TOP 2 SVNnumber FROM tblLogSVN")
If rs.RecordCount Then
rs.MoveFirst
Me.SVN1 = rs!SVNnumber
Me.Pc1 = True
End If
End If

If IsNull(Me.SVN2) Or Me.SVN2 = "" And Me.Pc1 = True Then
MsgBox " SVN2.!!", vbInformation, "Warning"
Set rs = CurrentDb.OpenRecordset("SELECT TOP 2 SVNnumber FROM tblLogSVN")
If rs.RecordCount Then
rs.MoveNext
Me.SVN2 = rs!SVNnumber
Me.Pc2 = True
End If
End If

End Sub

Εάν θές δοκίμασε το και εσύ στην βάση που έχω επισυνάψει φίλε.

Σε ευχαριστώ

[kapetang]

Καλησπέρα

Γιώργο, ο κώδικάς σου τρέχει και μάλλον πιστεύεις ότι σε καλύπτει πλήρως, οπότε δεν έχει νόημα η περαιτέρω συζήτηση.

Γράφω το κείμενο αυτό, επειδή, κατά τη γνώμη μου, το φόρουμ θα πρέπει να συμβάλλει στη χρήση από τα μέλη του των καλύτερων τεχνικών.

Έτσι θα επισημάνω κάποιες αδυναμίες:

1) Η πρόταση δήλωσης βρίσκεται μέσα σε μπλοκ If με αποτέλεσμα, η μεταβλητή rs, άλλοτε να δηλώνεται και άλλοτε όχι.

2) Είναι φλύαρος (επαναλαμβάνει εντολές). Για παράδειγμα.

• Αντί μιας εντολής ορισμού της μεταβλητής rs έχει 2.
• Αντί ενός ελέγχου του πλήθους των εγγραφών του rs έχει 2.

Σημειώνεται ότι αν το rs δεν έχει εγγραφές δεν μπορεί να ενημερωθεί κανένα από τα πεδία SVN1 και SVN2, οπότε ο έλεγχος αυτός θα πρέπει να προηγηθεί όλων των άλλων.

3) Δεν ελέγχεται αν το rs έχει τουλάχιστον 2 εγγραφές. Αν έχει λιγότερες από 2 το πεδίο SVN2 δεν μπορεί να ενημερωθεί.

Τώρα που έγινε πλήρως κατανοητό το ζητούμενο, θα μπορούσε να χρησιμοποιηθεί ο παρακάτω κώδικας.

Private Sub cmdAddPc_Click()

    Dim rs As DAO.Recordset

    Set rs = CurrentDb.OpenRecordset("SELECT TOP 2 SVNnumber FROM tblLogSVN")
    rs.MoveLast
    If rs.RecordCount Then
        If Nz(Me.SVN1, "") = "" Then
            rs.MoveFirst
            Me.SVN1 = rs!SVNnumber
            Me.Pc1 = True
        ElseIf Nz(Me.SVN2, "") = "" And rs.RecordCount > 1 Then
            rs.MoveLast
            Me.SVN2 = rs!SVNnumber
            Me.Pc2 = True
        Else
            'Εδώ αντιμετωπίζεται η περίπτωση που έχουν προστεθεί 2 Pc
            'Αν δε χρειάζεται το τμήμα Else μπορεί να διαγραφεί.
            MsgBox "Δε μπορούν να προστεθούν άλλα Pc. Η εφαρμογή θα κλείσει"
            Application.Quit
        End If
    End If
End Sub

Φιλικά/Γιώργος