Ένας φίλος του ιστολογίου, έστειλε την παρακάτω ερώτηση: Σε ένα φύλλο, έχω τυποποιήσει μία φόρμα, πάνω στην οποία συλλέγω διάφορα στοιχεία. Προσπαθώ να γράψω μια μακροεντολή ώστε όταν ολοκληρώνω την δουλεία μου με την φόρμα, όλα τα δεδομένα να υποθηκεύονται σε μία βάση και η φόρμα να καθαρίζει και να είναι έτοιμη να υποδεχτεί νέα δεδομένα.
Για τη λύση του προβλήματος αυτού θα χρειαστούμε το φύλλο με τη φόρμα (πρώτη εικόνα), το φύλλο που θα υποδέχεται τα δεδομένα της φόρμας (βάση, δεύτερη εικόνα) και λίγο κώδικα ο οποίος έχει γραφτεί σε πολύ απλή μορφή, εύκολα προσαρμόσιμος στις δικές σας ανάγκες.
Στην πρώτη εικόνα είναι ένα απλό παράδειγμα φόρμας.
Το φύλλο “Φόρμα”
Κάποια από τα κελιά (B2,B4, B6,…) ενημερώνονται χειριστικά και κάποια (B12, B14, B16, D19) από συναρτήσεις. Όταν ο χρήστης ολοκληρώσει τη δουλειά που έχει να κάνει με την φόρμα, πατά το πλήκτρο: “Μεταφορά στη βάση & καθάρισμα της φόρμας” και τα δεδομένα της, δημιουργούν μια νέα εγγραφή (σειρά) στη βάση. (εικόνα 2).
Το φύλλο “Βάση” / Κλίκ για μεγέθυνση
Η ίδια η φόρμα καθαρίζει και είναι έτοιμη να υποδεχτεί νέα δεδομένα. (εικόνα 3).
εικόνα 3
Ακολουθεί ο κώδικας που θα χρειαστείτε και αναλυτικές οδηγίες για να τον προσαρμόσετε στις δικές σας ανάγκες.
Sub UpdateBaseAndCleanForm()
Dim t1, t2, t3, t4, t5 As Range
Dim t6, t7, t8, t9, t10 As Range
Dim arrayData As Variant
Dim cleanData As Range
Dim keli As Range
Dim baseSheet As Object
Dim formaSheet As Object
Dim meter As Long
Set baseSheet = Sheets("Βάση")
Set formaSheet = Sheets("Φόρμα")
Set t1 = formaSheet.Range("B2")
Set t2 = formaSheet.Range("B4")
Set t3 = formaSheet.Range("B6")
Set t4 = formaSheet.Range("B8")
Set t5 = formaSheet.Range("B10")
Set t6 = formaSheet.Range("B12")
Set t7 = formaSheet.Range("B14")
Set t8 = formaSheet.Range("B16")
Set t9 = formaSheet.Range("D19")
Set t10 = formaSheet.Range("D20")
meter = Application.WorksheetFunction.CountA(baseSheet.Range("A:A"))
arrayData = VBA.Array(meter, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10)
Set cleanData = Union(t1, t2, t3, t4, t5, t10)
With cleanData.Cells
Set keli = .Find(What:="*", LookIn:=xlValues)
If keli Is Nothing Then GoTo telos
End With
baseSheet.Cells(meter + 1, 1).Resize(, 11) = arrayData
cleanData.ClearContents
telos:
End Sub
Στο παράδειγμα μεταφέρονται από τη φόρμα στη βάση 10 τιμές από 10 κελιά. Αν οι τιμές που θα εσείς θα μεταφέρνετε από τη φόρμα σας προς τη βάση σας, είναι περισσότερες, προσθέστε μεταβλητές t. Παράδειγμα για 17 τιμές προσθέστε μια ακόμα γραμμή κώδικα:
Dim t11, t12, t13, t14, t15, t16, t17 As Range
