Forum

Αναζήτηση στο ms-office.gr

Πάμε!
ms-office.gr > Forum > Microsoft Excel > Excel - Ερωτήσεις / Απαντήσεις > [VBA] Δημιουργία Backup πολλών αρχείων

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

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

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 20-07-11, 23:08
mak Ο χρήστης mak δεν είναι συνδεδεμένος
Όνομα: Μανώλης
Έκδοση λογισμικού Office: Ms-Office 2003
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 15-05-2011
Περιοχή: ΗΡΑΚΛΕΙΟ
Μηνύματα: 26
Προεπιλογή Δημιουργία Backup πολλών αρχείων

Καλησπερα σε όλους σας
Η ερωτηση μου ειναι η εξης : Εχω μια λίστα με αρχεια xls τα οποία χρειάζεται καθε τέλος μηνα να κραταμε ενα αντιγραφο backup με διαφορετικό όνομα. πχ. ενα αρχεο απο την λιστα είναι 153_name1.xls και το αντιγραφο του θα ειναι π.χ 153_2011_07.xls. Παραλληλα στο αντιγραφο δεν θα αποθηκευουνται καποιοι τυποι, αλλα μόνο οι τιμες των αποτελεσμάτων τους.
Μια προσπαθεια εγινε απο την πλευρά μου, "ερασιτεχνική", καταγραφοντας σε ενα module το παρακάτω κώδικα , τοσες φορες όσες και τα αρχεια της λίστας. Σιγουρα γίνεται με πολυ πιο γρήγορο τρόπο αλλά προς στιγμή το αποτελεσμα με ικανοποιει "μερικώς", εκτος απο το οτι καθε φορα που εκτελειται μια απο τις μακροεντολές οπως η παρακτω, το αρχειο που καλειται να ανοιξει απο την hyperlink που βρισκεται π.χ. στο B6 κελι, και επειδη αυτο περιεχει μακροεντολές και συνδεσεις με αλλα βιβλία, ζηταει να ενεργοποιηθουν οι μακροεντολές ή οχι και να ενημερωθουν ή οχι οι συνδεσεις. Γίνεται μεσα στο κώδικα να ορίσω τις απαντησεις στις δυο αυτές ερωτήσεις. (χωρις να τις απενεργοποιησω απο τις επιλογες) ???

Sub bak153()
' bak153 Μακροεντολή
Range("B6").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("ΕΙΣΠΡΑΞΗ").Select
Range("M10:O29").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("ΚΑΤΑΣΤΑΣΗ").Select
tname = Range("AC5").Value
ChDir "C:\Documents and Settings\user\Τα έγγραφά μου\153_bak"
ActiveWorkbook.SaveAs Filename:=tname
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Απάντηση με παράθεση
  #2  
Παλιά 21-07-11, 13:17
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.234
Προεπιλογή

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

Δοκίμασε το αρχικά σε κόπιες των αρχείων σου για να δεις αν είναι αυτό που χρειάζεσαι.

Αν χρειαστείς κάτι, εδώ είμαστε!

Με εκτίμηση

Τάσος
Συνημμένα Αρχεία
Τύπος Αρχείου: xls XL_BackFiles.xls (98,0 KB, 68 εμφανίσεις)
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών

Τελευταία επεξεργασία από το χρήστη Tasos : 22-07-11 στις 11:34. Αιτία: Προσθήκη μηχανισμού αρίθμησης αρχείων
Απάντηση με παράθεση
  #3  
Παλιά 22-07-11, 00:55
mak Ο χρήστης mak δεν είναι συνδεδεμένος
Όνομα: Μανώλης
Έκδοση λογισμικού Office: Ms-Office 2003
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 15-05-2011
Περιοχή: ΗΡΑΚΛΕΙΟ
Μηνύματα: 26
Προεπιλογή

Τασο καλησπερα
Δοκίμασα την εκδοχη που ανεβασες και πραγματικά είναι πολυ καλή σε αυτό που χρειάζομαι.

Εχω να παρατηρήσω πρωτα κάτι (οχι σημαντικό για την εφαρμογή μου, απλα για την ιστορία) :
Οταν δεν εχεις κανει check στο "Αντικατάσταση αρχείων με το ίδιο όνομα" τότε ακομα και αδειος να ειναι ο φακελος των αντγράφων, δεν δημιουργει κανενα αντίγραφο και στη στηλη "J" βγαζει "Υπάρχει ήδη αντίγραφό ασφαλείας!"

Τωρα θα ηθελα να ρωτησω δύο πραγματα.
α. Μπορει (?) το ονομα του αρχειου backup που δημιουργειται να κρατάει μονο τα τρία πρωτα ψηφια απο το παλιό ονομα -και οχι όλο - και να προσθετει την κατάληξη ????
π.χ. απο 153_name1.xls να γίνεται 153_2011_07.xls
β. Μπορει (?) να προστεθεί και δευτερη περιοχή τυπων (που θα επικολά μονο τις τιμές) με αντιστοιχο όνομα φύλλου ??? (Μια προσπαθεια απο την πλευρα μου να το κανω, κοιτωντας τον κωδικα του αρχειου, δεν βγηκε πουθενα)

και κατι τελευταιο, αν δεν έχω κουρασει ήδη
[ισως να επρεπε να το δημιουργησω ως ξεχωριστό θεμα στο forum, αλλά νομίζω ότι έχει άμμεση σχεση με αυτό]

Εχω μια περιοχη πχ Α2:Α100 με την πληρη διευθυνση κάποιων αρχειων (path\name) και στη περιοχη Β2:Β100 την νεα διευθυνση που θελω να αντιγραψω το καθε αρχειο αντιστοιχα.
(παραδειγμα στο αρχειο που εχω ανεβασει (test_bak.xls).
Τι κωδικα να χρησιμοποιησω για να το κανω μαζικα για όλα τα αρχεια ?.
(Θα χρησιμοποιω το test_bak πχ για να κανω copy
και ενα test_bak2 για να κάνω move καποια άλλα αρχεια. Λογικά θα ειναι ο ιδιος κώδικας με διαφορά στην εντολη copy και move ???)

Ευχαριστώ παρα πολύ

Φιλικά

Μανώλης
Συνημμένα Αρχεία
Τύπος Αρχείου: xls test_ bak.xls (14,5 KB, 44 εμφανίσεις)
Απάντηση με παράθεση
  #4  
Παλιά 22-07-11, 06:51
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.234
Προεπιλογή

Καλημέρα Μανώλη!
Παράθεση:
β. Μπορει (?) να προστεθεί και δευτερη περιοχή τυπων (που θα επικολά μονο τις τιμές) με αντιστοιχο όνομα φύλλου ???
Από που προέρχονται οι τιμές αυτές;

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση
  #5  
Παλιά 22-07-11, 08:21
mak Ο χρήστης mak δεν είναι συνδεδεμένος
Όνομα: Μανώλης
Έκδοση λογισμικού Office: Ms-Office 2003
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 15-05-2011
Περιοχή: ΗΡΑΚΛΕΙΟ
Μηνύματα: 26
Προεπιλογή

Καλημέρα Τασο !!
Στο αρχειο που ανεβασες στη σειρα 3 εχει "Όνομα Φύλλου όπου θα μετατροπούν οι τύποι:" και εισγουμε π.χ. ΕΙΣΠΡΑΞΗ και περιοχη Μ10:Ο29.
Το ζητουμενο αν μπορει να προστεθει - στο αρχειο που ηδη εχεις ανεβασει εννοειται - αλλο ενα set φυλλου και περιοχης πχ. (φυλλο ΠΛΗΡΩΜΗ και περιοχη Κ10:L29)

Ευχαριστω
Απάντηση με παράθεση
  #6  
Παλιά 22-07-11, 08:25
mak Ο χρήστης mak δεν είναι συνδεδεμένος
Όνομα: Μανώλης
Έκδοση λογισμικού Office: Ms-Office 2003
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 15-05-2011
Περιοχή: ΗΡΑΚΛΕΙΟ
Μηνύματα: 26
Προεπιλογή

Το οποίο set θα κανει και αυτο την ιδια δουλεια ... αποθήκευση των αποτελεσματων και οχι των τυπων της περιοχής.
Απάντηση με παράθεση
  #7  
Παλιά 22-07-11, 12:15
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.234
Προεπιλογή

Γεια σας!
Φίλε Μανώλη, έκανα κάποιες διορθώσεις στο παράδειγμα του προηγούμενου μηνύματος μου .
Δες το και προσανατολίσου στις τεχνικές που εφαρμόζονται.

Στο τελευταίο σου ερώτημα:

Ο παρακάτω κώδικας με ελάχιστες προσαρμογές πιστεύω ότι θα σε βοηθήσει.

Πριν τρέξεις τον κώδικα αυτό, πήγαινε στον VBE στο μενού Tools>References, βρες και τσέκαρε την επιλογή "Microsoft Scripting Runtime".


Κώδικας:
Option Explicit
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
                                             ByVal lpPath As String) As Long


Sub test()
    Dim c As Range, NewFileName As String
    Dim fso As New Scripting.FileSystemObject
    For Each c In Range("A2:A100")
        If Not IsEmpty(c) Then
            If fso.FileExists(c.Text) Then
                If Not fso.FolderExists(c.Offset(, 1).Text) Then MakeSureDirectoryPathExists c.Offset(, 1).Text
                If fso.FolderExists(c.Offset(, 1).Text) Then
                    NewFileName = Replace(c.Offset(, 1) & "\" & Mid$(c, InStrRev(c, "\") + 1), "\\", "\")
                    If Left(NewFileName, 1) = "\" Then NewFileName = "\" & NewFileName
                    fso.CopyFile Source:=c.Text, Destination:=NewFileName, OverWriteFiles:=True ' Αντιγραφή 
                    ' fso.MoveFile Source:=c.Text, Destination:=NewFileName ' Μεταφορά
                Else
                    '.....Ο φάκελος προορισμού δεν υπάρχει και ούτε πορεί να δημιουργηθεί
                End If
            Else
                '.......Το αρχείο/ πηγή δεν υπάρχει
            End If
        End If
    Next
End Sub

Καλή συνέχεια!

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση
  #8  
Παλιά 23-07-11, 19:21
mak Ο χρήστης mak δεν είναι συνδεδεμένος
Όνομα: Μανώλης
Έκδοση λογισμικού Office: Ms-Office 2003
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 15-05-2011
Περιοχή: ΗΡΑΚΛΕΙΟ
Μηνύματα: 26
Προεπιλογή

Καλησπερα σε όλους
Φιλε Τάσο
Η διορθωμένη εκδοση του αρχειου σου, κανει οτι ακριβως ηθελα... και με το παραπάνω θα έλεγα.
Επισης και ο εξτρα κωδικας, για το copy και move είναι άψογος.

Ενα μεγαλο ευχαριστω για το χρόνο σου και την πολυτιμη βοηθεια σου !!!

Με εκτιμηση

Μανώλης
Απάντηση με παράθεση
Απάντηση στο θέμα

Εργαλεία Θεμάτων
Τρόποι εμφάνισης

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

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


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

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
Backup anestaki Access - Ερωτήσεις / Απαντήσεις 0 06-11-16 19:14
Δημιουργία, αρχείων με αύξοντα αριθμό πρωτοκόλλου. Spirosgr Word samples - Χρήσιμα αρχεία & παραδείγματα 0 21-09-15 20:55
Ένωση πολλών αρχείων Word σε ένα με χρήση Access dimmag Access - Ερωτήσεις / Απαντήσεις 2 21-02-14 18:58
[Εκτύπωση] Εκτύπωση πολλών αρχείων, πολλών επιλογών mak Excel - Ερωτήσεις / Απαντήσεις 7 11-06-12 12:34
[ Φόρμες ] Backup xristos0718 Access - Ερωτήσεις / Απαντήσεις 2 15-04-10 20:41


Η ώρα είναι 21:47.