Ανανέωση ιστοσελίδας
ms-office.gr > Forum > Microsoft Excel > Excel - Ερωτήσεις / Απαντήσεις > [VBA] Πώς εμποδίζουμε την αποθήκευση αρχείου Excel

Excel - Ερωτήσεις / Απαντήσεις Ότι έχει σχέση με συναρτήσεις, μορφοποίηση, εκτυπώσεις γραφήματα κτλ.

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 18-01-22, 12:03
Όνομα: Κώστας
Έκδοση λογισμικού Office: Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 16-03-2015
Μηνύματα: 151
Προεπιλογή Πώς εμποδίζουμε την αποθήκευση αρχείου Excel

Την καλησπέρα μου σε όλους.
Χτες μου ζήτησε κάτι ο Διευθυντής μου, το οποίο ξεφεύγει λίγο από τις ικανότητες και τις γνώσεις μου.
Έχουμε 48 διαφορετικά αρχεία Excel με 8-10 φύλλα εργασίας το καθένα, όπου περνάμε τις βαθμολογίες των μαθητών μας.
Μου ζήτησε λοιπόν, αν ο μέσος όρος ενός μαθήματος είναι πάνω από 18,5 να βγαίνει ένα προειδοποιητικό μήνυμα (π.χ. "Υψηλή βαθμολογία") και - αν είναι δυνατόν - να μην αφήνει τον χρήστη να αποθηκεύσει το αρχείο αν δεν πέσει ο μέσος όρος κάτω από 18,5.
Ήδη στα αρχεία υπάρχουν διάφορες μακροεντολές με βάση τις οποίες αυτοματοποιούνται πολλές διεργασίες - να είναι καλά τα παιδιά του forum - αλλά αυτό είναι κάτι που δεν πάει το μυαλό μου πως μπορεί να γίνει (ούτως ή άλλως από VBA...)
Αν βρεθεί τρόπος να γίνει κάτι τέτοιο θα ήθελα και μια πρόταση σχετικά με το πως μπορεί να περαστεί αυτή η διαδικασία, όσο πιο εύκολα γίνεται, σε 450 -480 διαφορετικά φύλλα εργασίας.
Ευχαριστώ για τον χρόνο σας.
Ελπίζω στην καθοδήγησή σας.
Απάντηση με παράθεση
  #2  
Παλιά 19-01-22, 08:14
Όνομα: Κώστας
Έκδοση λογισμικού Office: Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 16-03-2015
Μηνύματα: 151
Προεπιλογή

Καλημέρα σε όλο το forum.
Ψάχνοντας στο διαδίκτυο να βρω ιδέες για να λύσω το θέμα μου κατέληξα στον παρακάτω κώδικα:

"Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
If Application.Sheets(I).Range("S22").Value > 18.5 Then
Cancel = True
MsgBox "Η αποθήκευση ακυρώθηκε." & Chr(13) & "Ο μέσος όρος βαθμολογίας στο μάθημα" & Chr(13) & "είναι πολύ υψηλός." & Chr(13) & "Παρακαλώ επανεξετάστε τους βαθμούς σας." & Chr(13) & "Εκ της Διευθύνσεως."
End If
Next I
End Sub"

Σε κάποιες δοκιμές που έχω κάνει φαίνεται να δουλεύει όπως πρέπει.
Η μόνη περίπτωση που παρατήρησα να έχει πρόβλημα είναι όταν δεν υπάρχουν βαθμοί στο φύλλο εργασίας - άρα δεν υπάρχει και μέσος όρος - οπότε δεν αφήνει το βιβλίο εργασίας να αποθηκευτεί. Ενώ λογικά θα έπρεπε, αφού η τιμή του κελιού που ελέγχει ο κώδικας είναι κάτω από 18,5 (στην πραγματικότητα δεν υπάρχει τιμή στο κελί αυτό).
Μήπως κάποιος μπορεί να βοηθήσει να ξεπεράσουμε αυτό το τελευταίο θέμα;
Ευχαριστώ πολύ.
Απάντηση με παράθεση
  #3  
Παλιά 19-01-22, 18:51
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

Καλησπέρα

Δοκίμασε τον κώδικα:

Κώδικας:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim WS_Count As Integer
    Dim I As Integer, mo As Variant
    
    WS_Count = ActiveWorkbook.Worksheets.Count
    For I = 1 To WS_Count
        mo = Application.Sheets(I).Range("S22").Value
        If (mo > 18.5) * (mo <> 0) * (mo <> "") Then
            Cancel = True
            MsgBox "Η αποθήκευση ακυρώθηκε." & Chr(13) & _
                   "Ο μέσος όρος βαθμολογίας στο μάθημα" & Chr(13) & _
                   "είναι πολύ υψηλός." & Chr(13) & _
                   "Παρακαλώ επανεξετάστε τους βαθμούς σας." & Chr(13) & _
                   "Εκ της Διευθύνσεως."
        End If
    Next I
End Sub
Απάντηση με παράθεση
  #4  
Παλιά 20-01-22, 07:44
Όνομα: Κώστας
Έκδοση λογισμικού Office: Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 16-03-2015
Μηνύματα: 151
Προεπιλογή

Καλημέρα Γιώργο και σ' ευχαριστώ για την απάντησή σου.
Η αποθήκευση του αρχείου προχωράει τώρα κανονικά σε κάθε περίπτωση.
Να είσαι καλά και καλή συνέχεια.
Απάντηση με παράθεση
  #5  
Παλιά 19-02-22, 16:41
Όνομα: Δημήτρης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 02-10-2011
Μηνύματα: 77
Προεπιλογή Εφαρμογη λυσης

Καλησπερα, επειδη με ενδιαφερει η λυση που προτεινατε θα μπορουσα να το χρησιμοποιησω στο αρχειο μου. Αν καταλαβα καλα, δεν επιτρεπει την αποθηκευση αρχειου αν δεν πληροι καποιες προυποθεσεις τιμων σε κελια
Απάντηση με παράθεση
  #6  
Παλιά 19-02-22, 20:57
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

Καλησπέρα

Ο κώδικας δεν επιτρέπει την αποθήκευση, όταν η τιμή στο κελί S22, σε όλα τα φύλλα, δεν ικανοποιεί κάποια συνθήκη.

Με κατάλληλη προσαρμογή θα μπορούσες να τον χρησιμοποιήσεις.
Απάντηση με παράθεση
Απάντηση στο θέμα


Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[Γενικά] Αποθήκευση αρχείου manolis Excel - Ερωτήσεις / Απαντήσεις 0 13-02-20 16:29
[VBA] Δημιουργία αρχείου για την αποθήκευση συγκεντρωτικών φακελων agrbita Excel - Ερωτήσεις / Απαντήσεις 8 25-09-18 11:05
[Excel07] Εισαγωγή δεδομένων από Excel και αυτόματη αποθήκευση sotisanis Excel - Ερωτήσεις / Απαντήσεις 1 03-11-13 11:00
[Γενικά] βοήθεια με άνοιγμα αρχείου excel koumpana Excel - Ερωτήσεις / Απαντήσεις 1 20-06-12 11:49
[Γενικά] Μορφοποιήσεις αρχείου Excel και Αναζήτηση kormos Excel - Ερωτήσεις / Απαντήσεις 8 15-02-11 11:34


Η ώρα είναι 01:13.