Forum

Forum (https://www.ms-office.gr/forum/)
-   Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)
-   -   [ Συναρτήσεις ] Ένωση Κωδίκων (VBA) (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/3621-enosi-kodikon-visual-basic-applications.html)

dimitrisp 31-03-15 19:15

Ένωση Κωδίκων (VBA)
 
Καλησπέρα στο Forum.
Θα ήθελα τη βοήθειά σας στο ακόλουθο θέμα:
Στο συμβάν AfterUpdate ενος πεδίου Φόρμας έχω τοποθετήσει την εντολή:

Private Sub PROKATABOLI_AfterUpdate()
Me.Refresh
If Me.PROKATABOLI.Value < POSO_Á Then
Dim intAnswer As Byte
intAnswer = MsgBox("............ ;", vbYesNo + vbExclamation + vbDefaultButton1, "Έλεγχος!")
If intAnswer = vbYes Then
stDocName = "NewPistosi"
DoCmd.OpenForm stDocName, acNormal, acDialog
Forms![NewPistosi]![D5] = Me.[PROKATABOLI]
Forms![NewPistosi]![PERIGRAFIP] = Me.[EPONYMO]
Forms![NewPistosi]![KATIGORIAP] = Me.[ETAIREIA]
MsgBox ".......................................... !", vbInformation, "Έλεγχος!"
DoCmd.Close
End If
If intAnswer = vbNo Then
stDocName = "NewPistosi"
DoCmd.OpenForm stDocName, acNormal, acDialog
Forms![NewPistosi]![D5] = Me.[PROKATABOLI]
Forms![NewPistosi]![PERIGRAFIP] = Me.[EPONYMO]
MsgBox "..................................... !", vbExclamation, "Έλεγχος!"
End If
End Sub

Ακολούθως, στο συμβάν LostFocus του ίδιου πεδίου έχω τοποθετήσει την εντολή:

Private Sub PROKATABOLI_LostFocus()
If Me.PROKATABOLI.Value = POSO_Á Then
Dim intAnswer As Byte
intAnswer = MsgBox("...............;", vbYesNo + vbExclamation +vbDefaultButton1, "Έλεγχος!")
If intAnswer = vbYes Then
stDocName = "NewPistosi"
DoCmd.OpenForm stDocName, acNormal, acDialog
Forms![NewPistosi]![D5] = Me.[POSO_Á]
Forms![NewPistosi]![D6] = Me.[POSO_Á] * -1
MsgBox ".............................. !", vbInformation, "Έλεγχος!"
DoCmd.Close
End If
If intAnswer = vbNo Then
stDocName = "NewPistosi"
DoCmd.OpenForm stDocName, acNormal, acDialog
Forms![NewPistosi]![D6] = Me.[POSO_Á] * -1
MsgBox "................................... !", vbExclamation, "Έλεγχος!"
End If
End If
End Sub
Οι Κώδικες αυτοί μου παρέχουν το επιθυμητό αποτέλεσμα.

Αυτό που θέλω να εφαρμόσω είναι να συνενώσω τους παραπάνω Κώδικες και να τους τοποθετήσω στο συμβάν AfterUpdate, έτσι ώστε να εχω το ίδιο αποτέλεσμα.

Στις προσπάθειές μου να το πετύχω (με τα λίγα που γνωρίζω) μου βγάζει το μήνυμα:
"Duplicate declaration in current scope"

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

Με εκτίμηση
Δημήτρης

kapetang 31-03-15 19:27

Μάλλον με τη συνένωση των δύο ρουτινών η μεταβλητή intAnswer δηλώνεται 2 φορές.
Η νέα ρουτίνα πρέπει να έχει μόνο μία δήλωση: Dim intAnswer As Byte

dimitrisp 31-03-15 19:51

Γιώργο, Καλησπέρα και σ' ευχαριστώ για την άμεση απάντησή σου.

Μόλις δοκίμασα αυτό που πρότεινες και διαπίστωσα ότι έχεις δίκιο: Το πρόβλημα δημιουργείται απο το "Dim intAnswer As Byte".
Αλλά όταν το διαγράφω (με ενοποιημένους και τους δύο Κώδικες) δεν λειτουργεί καθόλου ο ενοποιημένος Κώδικας.
Έχεις καμιά άλλη ιδέα;

Φιλικά
Δημήτρης

Meteora 31-03-15 20:18

Καλησπέρα
τον ορισμό της μεταβλητής
Κώδικας:

Dim intAnswer As Byte
να το βάλεις μία φορά, ΠΡΙΝ ξεκινήσουν τα if...then...endif

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

dimitrisp 31-03-15 23:27

Νίκο, σ'ευχαριστώ για την ενασχόλησή σου με το θέμα μου.
Τοποθέτησα τον ορισμό της μεταβλητής "Dim intAnswer As Byte", όπως πρότεινες, στην αρχή και μετά από το " Private Sub PROKATABOLI_AfterUpdate()".
Παράλληλα, τη διέγραψα από το "Private Sub PROKATABOLI_LostFocus()", έχοντας και τις δύο συναρτήσεις ενωμένες στο "AfterUpdate".
Τελικά, η ενωμένη συνάρτηση δεν λειτουργεί (ανταποκρίνεται) καθόλου.
Ενδεχομένως, κάτι δεν κάνω σωστά ;


Με εκτίμηση
Δημήτρης

Meteora 01-04-15 11:42

Καλημέρα

Δες αν πράγματι το συμβάν στο οποίο την αντιστοίχισες, την ενεργοποιεί !

Είσαι σε θέση να "μαρκάρεις" τον κώδικα και να δεις βήμα-βήμα πώς γίνεται η ροή ;

Νίκος

Rogerk 01-04-15 18:17

Φίλε Δημήτρη
Χρησιμοποίησε τον παρακάτω κώδικα και πες μου αν σου δουλεύει.

Κώδικας:

Private Sub PROKATABOLI_AfterUpdate()
    Me.Refresh
    On Error GoTo Error_Handler

    Dim intAnswer As Integer
    Dim stDocName As String

If Me.PROKATABOLI.Value < POSO_Á Then
    intAnswer = MsgBox("............ ;", vbYesNo + vbExclamation + vbDefaultButton1, "??e????!")

    Select Case intAnswer
    Case vbYes
        stDocName = "NewPistosi"
        DoCmd.OpenForm stDocName, acNormal, acDialog
        Forms![NewPistosi]![D5] = Me.[PROKATABOLI]
        Forms![NewPistosi]![PERIGRAFIP] = Me.[EPONYMO]
        Forms![NewPistosi]![KATIGORIAP] = Me.[ETAIREIA]
        MsgBox ".......................................... !", vbInformation, "??e????!"
        DoCmd.Close
        Response = acDataErrAdded
    Case vbNo
        stDocName = "NewPistosi"
        DoCmd.OpenForm stDocName, acNormal, acDialog
        Forms![NewPistosi]![D5] = Me.[PROKATABOLI]
        Forms![NewPistosi]![PERIGRAFIP] = Me.[EPONYMO]
        MsgBox "..................................... !", vbExclamation, "??e????!"
        Response = acDataErrContinue
    End Select
   
    ElseIf Me.PROKATABOLI.Value = POSO_Á Then

    intAnswer = MsgBox("...............;", vbYesNo + vbExclamation + vbDefaultButton1, "¸ëåã÷ïò!")

    Select Case intAnswer
    Case vbYes
        stDocName = "NewPistosi"
            DoCmd.OpenForm stDocName, acNormal, acDialog
            Forms![NewPistosi]![D5] = Me.[POSO_A]
            Forms![NewPistosi]![D6] = Me.[POSO_A] * -1
            MsgBox ".............................. !", vbInformation, "¸ëåã÷ïò!"
            DoCmd.Close
        Response = acDataErrAdded
    Case vbNo
      stDocName = "NewPistosi"
            DoCmd.OpenForm stDocName, acNormal, acDialog
            Forms![NewPistosi]![D6] = Me.[POSO_A] * -1
            MsgBox "................................... !", vbExclamation, "¸ëåã÷ïò!"
        Response = acDataErrContinue
    End Select
End If
   
Exit_Procedure:
    DoCmd.SetWarnings True
    Exit Sub
Error_Handler:
    MsgBox Err.Number & ", " & Err.Description
    Resume Exit_Procedure
    Resume
End Sub


dimitrisp 01-04-15 18:51

Φίλε Κώστα,
Ο ενοποιημένος Κώδικας και των δύο εντολών λειτουργεί άψογα. Μάλιστα, πρόσθεσα με επιτυχία και τρίτη εντολή (παρόμοια).

Θερμές ευχαριστίες. Νάσαι καλά και καλή συνέχεια...

Φιλικά/Δημήτρης

dimitrisp 02-04-15 00:36

Νίκο (meteora),
επανέρχομαι, ως όφειλα, προς ενημέρωσή σου, αλλά και προς ενημέρωση των φίλων του Forum, που πιθανόν ενδιαφέρονται για το ίδιο θέμα:
Ακολούθησα τις υποδείξεις σου, διορθώνοντας τον Κώδικα με αποτέλεσμα να λειτουργεί άψογα. (μετά την ένωση των δυο Κωδίκων, αντκατέστησα στην αρχή του δεύτερου Κώδικα το " If Me.PROKATABOLI.Value = POSO_Á Then" με το "ElseIf Me.PROKATABOLI.Value = POSO_Á Then").
Θερμές ευχαριστίες για τη βοήθειά σου.
Επίσης, με την ευκαιρία αυτή, επίτρεψέ μου, να εκφράσω και τις θερμές μου ευχαριστίες για την, με σεβασμό και χωρίς διακρίσεις,προσφερόμενη φιλοξενία και την πολύτιμη πολιτισμική βοήθεια του "Forum" στα Μέλη του ...

Με εκτίμηση/Δημήτρης

Meteora 02-04-15 08:04

Καλημέρα

Ό,τι είναι το Forum οφείλεται σε όλα τα μέλη. Απλά! Η προσφορά κάποιων είναι α ν ε κ τ ή μ ι τ η και χωρίς ...όρια. (Τάσος, Σπύρος, Γιώργος ).

...και να σκεφτεί κανείς ότι οι δύο πρώτοι κύριοι δεν ζουν στην Ελλάδα. Θα μπορούσαν να γράψουν και να ηγηθούν σε forum ξενόγλωσσα με αρκετές χιλιάδες μέλη -να αναπτύξουν γνωριμίες, δουλειές...- και όμως σκέφτηκαν ότι έπρεπε να βοηθήσουν εμάς, εδώ στην Ελλάδα και στη Κύπρο, χωρίς ίχνος -ως προς την απόφασή τους- ρατσισμού και συγγενών ...'χαζομάρων'.
Ο Γιώργος ακολουθεί με συνέπεια το λιτό σκεπτικό "Αφού μπορώ να το κάνω. Να το κάνω ή όχι ; και απαντά : θα το κάνω"

Άντε... καλή συνέχεια σε όλους.
Νίκος


Η ώρα είναι 10:54.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2