[kapetang]

Καλησπέρα στην παρέα

Κωνσταντίνε, πραγματικά κάποιος που δεν έχει υπόψη του τα προηγούμενα μηνύματα είναι δύσκολο να αντιληφθεί τι ακριβώς θέλεις.
Για να πετύχεις το ζητούμενο, θα πρέπει να αλλάξεις το πεδίο «ID_ΗΘΟΠΟΙΟΥ» στον πίνακα «ΡΟΛΟΙ», ώστε να μη μπορεί να παίρνει πολλαπλές τιμές.
Αυτό θα αφαιρέσει από τη ΒΔ τη δυνατότητα ανάθεσης ενός ρόλου σε πολλούς ηθοποιούς, για να υπάρχει αντικαταστάτης σε περίπτωση κωλύματος του βασικού.
Για να κάνουμε την αλλαγή ακολουθούμε τα βήματα.
1. Για κάθε ενδεχόμενο, δημιουργία αντιγράφου ασφαλείας της ΒΔ.
2. Άνοιγμα της ΒΔ και με αντιγραφή και επικόλληση δημιουργία αντιγράφου του πίνακα «ΡΟΛΟΙ» με όνομα «ΡΟΛΟΙ2».
3. Άνοιγμα σε προβολή σχεδίασης του πίνακα «ΡΟΛΟΙ» και διαγραφή του πεδίου «ID_ΗΘΟΠΟΙΟΥ». Πιθανόν να χρειαστεί πρώτα η διαγραφή της σχέσης.
4. Προσθήκη πάλι του πεδίου «ID_ΗΘΟΠΟΙΟΥ» και στον τύπο δεδομένων επιλογή «Οδηγός αναζήτησης». Στον οδηγό δεν τσεκάρουμε το πλαίσιο «Εισαγωγή πολλών τιμών», ώστε όταν τον κλείσουμε η ιδιότητα του πεδίου «Δυνατότητα πολλών τιμών» να έχει τιμή: Όχι.
Μένει να αντιγράψουμε τις τιμές του πεδίου «ID_ΗΘΟΠΟΙΟΥ» από τον πίνακα «ΡΟΛΟΙ2» στο αντίστοιχο του πίνακα «ΡΟΛΟΙ».
Στη ΒΔ που επισυνάπτω, αν πατήσουμε το κουμπί «Αντιγραφή τιμών» της φόρμας «frmHelp» θα γίνει αυτόματα η αντιγραφή.
Η λειτουργικότητα του κουμπιού οφείλεται στον παρακάτω κώδικα:

Private Sub cmdUpdate_Click()
    Dim rsR1 As DAO.Recordset
    Dim rsR2 As DAO.Recordset
    Dim rst As DAO.Recordset
    Dim strSQL As String
    strSQL = "SELECT ΡΟΛΟΙ.ID_ΗΘΟΠΟΙΟΥ FROM ΡΟΛΟΙ ORDER BY ΡΟΛΟΙ.ID_ΡΟΛΟΥ;"
    Set rsR1 = CurrentDb.OpenRecordset(strSQL)
    strSQL = "SELECT ΡΟΛΟΙ2.ID_ΗΘΟΠΟΙΟΥ FROM ΡΟΛΟΙ2 ORDER BY ΡΟΛΟΙ2.ID_ΡΟΛΟΥ;"
    Set rsR2 = CurrentDb.OpenRecordset(strSQL)
    If rsR1.RecordCount > 0 Then
    rsR1.MoveFirst: rsR2.MoveFirst
        Do Until rsR1.EOF
            rsR1.Edit
            Set rst = rsR2!ID_ΗΘΟΠΟΙΟΥ.Value
            rsR1!ID_ΗΘΟΠΟΙΟΥ = rst.Fields(0)
            rsR1.Update
            rsR1.MoveNext: rsR2.MoveNext
        Loop
        rsR1.Close
        rsR2.Close
        MsgBox "Η ενημέρωση ολοκληρώθηκε"
    End If
End Sub

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