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

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

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

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 15-10-13, 18:48
Όνομα: Σωτήρης
Έκδοση λογισμικού Office: Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 26-05-2011
Περιοχή: Θεσσαλονίκη
Μηνύματα: 91
Προεπιλογή Αποθήκευση με ημερομηνία

Παιδια καλησπερα και παλι

Εχω αυτον τον κωδικα. Θελω ομως να κανω το εξης.Να αποθηκευεται πρωτα η ημερομηνια και μετα το ονομα του βιβλιου και καθε φορα που γινεται αποθηκευση να σβηνεται η παλια ημερομηνια

Κώδικας:
Sub SaveFileWithDate()
   Dim strWBOnly As String         'workbook path and name without ".xls"
    Dim strSaveWithDate As String
    Dim strWBFullName As String
  
    strWBFullName = ActiveWorkbook.FullName
    strWBOnly = Left(strWBFullName, Len(strWBFullName) - 4)
  
    strSaveWithDate = strWBOnly & "." & Format(Now(), "dd-mm-yyyy") & ".xls"
  
    ActiveWorkbook.SaveAs Filename:=strSaveWithDate, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
End Sub
τι πρεπει να αλλαξω ρε παιδια??
Απάντηση με παράθεση
  #2  
Παλιά 15-10-13, 22:40
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.011
Προεπιλογή

Σωτήρη καλησπέρα!

Ο παρακάτω παραδειγματικός κώδικας νομίζω ότι σε εξυπηρετεί:

Κώδικας:
Sub test()
    Dim xlFolder As String, wbName As String, ExtName As String, NewName As String
    xlFolder = ThisWorkbook.Path & "\" 'Προσάρμοσε τη διαδρομή του φακέλου
    With CreateObject("Scripting.FileSystemObject")
        wbName = .GetBaseName(ThisWorkbook.FullName)
        ExtName = "." & .GetExtensionName(ThisWorkbook.FullName)
    End With
    NewName = xlFolder & _
              Replace(Format(Now(), "dd_mm_yyyy_hh:mm:ss"), ":", "_") & "_" & wbName & ExtName
    ThisWorkbook.SaveAs NewName, ThisWorkbook.FileFormat ' ή xlnormal
End Sub
Εξήγησε μας πως προσδιορίζεται το αρχείο προς διαγραφή με την παλιά ημερομηνία για να σε βοηθήσουμε.

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση
  #3  
Παλιά 15-10-13, 22:46
Όνομα: Σωτήρης
Έκδοση λογισμικού Office: Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 26-05-2011
Περιοχή: Θεσσαλονίκη
Μηνύματα: 91
Προεπιλογή

Τασο καλησπερα

Καθε φορα που παταω αποθηκευση (φτιαγμενο κουμπι με vba) τοτε συνεχεια μου βαζει μπροστα το νουμερο της ημερομηνιας.

ενω οταν κανω αποθηκευση ως pdf με τον παρακατω κωδικα τοτε το αποθηκευει μια χαρα

εγω θελω καθε φορα να αποθηκευει εκ νεου ενα αρχειο με νεα αποθηκευση.
οχι να σβηνει το παλιο
πχ αν 7 μερες το ανοιξεις 7 φορες τοτε να εχει 7 διαφ αποθηκευσεις
Κώδικας:
Public Sub SaveWorksheetsAsPDF()


On Error Resume Next

Dim i As Integer
Dim sName As String
Dim sOutputPath As String
 Dim strWBOnly As String         'workbook path and name without ".xls"
    Dim strSaveWithDate As String
    Dim strWBFullName As String



For i = 1 To ActiveWorkbook.ActiveSheet.Count

strWBFullName = ActiveWorkbook.FullName
strWBOnly = Left(strWBFullName, Len(strWBFullName) - 4)
sName = strWBOnly & "." & Format(Now(), "dd-mm-yyyy")


Debug.Print ActiveSheet(sName).Index & " " & sOutputPath & sName

ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
sOutputPath & sName, Quality:=xlQualityMinimum _
, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Next

End Sub
Απάντηση με παράθεση
  #4  
Παλιά 16-10-13, 00:40
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.011
Προεπιλογή

Σωτήρη,
κατάλαβα ότι θέλεις κάθε φορά που πατάς το κουμπί να γίνεται αντικατάσταση του αρχείου με το ίδιο όνομα (αν υπάρχει) στο σκληρό δίσκο.

Δεν κατάλαβα όμως: Θέλεις να αποθηκεύσεις όλα τα φύλλα εργασίας του βιβλίου σε *.pdf
ή θέλεις να αποθηκεύεις το βιβλίο σε μορφή Excel;

Για να αποθηκεύεις το βιβλίο σε μορφή Excel χρησιμοποίησε το παρακάτω:
Κώδικας:
Sub testXL()
    Dim xlFolder As String, wbName As String, ExtName As String, NewName As String
    xlFolder = ThisWorkbook.Path & "\"
    With CreateObject("Scripting.FileSystemObject")
        wbName = .GetBaseName(ThisWorkbook.FullName)
        ExtName = "." & .GetExtensionName(ThisWorkbook.FullName)
        NewName = xlFolder & Format(Date, "dd_mm_yyyy") & "_" & wbName & ExtName
        On Error Resume Next
        If .FileExists(NewName) Then
            .DeleteFile NewName
        End If
    End With
    If Err <> 0 Then
        MsgBox "Σφάλμα: " & Err & vbLf & Err.Description
        Exit Sub
    Else
        ThisWorkbook.SaveAs NewName, ThisWorkbook.FileFormat    ' ? xlnormal
    End If
End Sub
Όσο για την εξαγωγή σε *.pdf θα πρέπει να διευκρινιστεί αν πρόκειται για ένα ή περισσότερα φύλλα.

Εκτός αυτού, ο κώδικας που παρουσιάζεις στο τελευταίο μήνυμα σου περιέχει κάποια σφάλματα.

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση
  #5  
Παλιά 16-10-13, 01:05
Όνομα: Σωτήρης
Έκδοση λογισμικού Office: Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 26-05-2011
Περιοχή: Θεσσαλονίκη
Μηνύματα: 91
Προεπιλογή

με το pdf δεν εχω κανενα θεμα.μια χαρα το αποθηκευει.μονο το lookup θα αποθηκευω σε pdf,ενω σε excel θελω να αποθηκευω ολο το βιβλιο.
για το pdf εμενα δεν μου βγαζει θεμα
Απάντηση με παράθεση
  #6  
Παλιά 16-10-13, 01:07
Όνομα: Σωτήρης
Έκδοση λογισμικού Office: Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 26-05-2011
Περιοχή: Θεσσαλονίκη
Μηνύματα: 91
Προεπιλογή

με τον κωδικα που μου εδωσες καθε φορα που παταω το κουμπι μου προσθετει ξανα την ημερομηνια
Απάντηση με παράθεση
  #7  
Παλιά 16-10-13, 02:05
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.011
Προεπιλογή

Σωτήρη, ο κώδικας που σου πρότεινα ήταν βασισμένος στον κώδικα που ανέβασες
και είναι λογικό να σου βγάζει 2 φορές την ημερομηνία στο όνομα του αρχείου έτσι που είναι στημένος.

Έστω ότι τρέχεις τον κώδικα μια φορά.

Το όνομα του βιβλίου που παραμένει ανοιχτό θα είναι 16_10_2013_όνομαΒιβλίου.xls
Αν λοιπόν ξανατρέξεις τον κώδικα στο βιβλίο 16_10_2013_όνομαΒιβλίου.xls που είναι ανοιχτό,
φυσικά θα σου προσθέσει και δεύτερη ημερομηνία στο ήδη υπάρχον όνομα δηλαδή το όνομα θα μετατραπεί σε: 16_10_2013_16_10_2013_όνομαΒιβλίου.xls .



Αν θέλεις το ίδιο βιβλίο να αποθηκεύεται περισσότερες φορές χωρίς να αλλάζει το όνομα του τότε:

Αντικατέστησε τη γραμμή: ThisWorkbook.SaveAs NewName, ThisWorkbook.FileFormat ' ? xlnormal

με τη γραμμή: ThisWorkbook.SaveCopyAs NewName

Για σένα αλλά και για τους υπόλοιπους φίλους που μας διαβάζουν, ο κώδικας που κάνει εξαγωγή σε *.pdf όλα τα φύλλα εργασίας ενός βιβλίου είναι:

Κώδικας:
Sub testPDFAllSheets()
    Dim xlFolder As String, wbName As String
    Dim i As Integer, NewName As String
    Dim fso As Object, wks As Worksheet
    xlFolder = ThisWorkbook.Path & "\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    wbName = fso.GetBaseName(ThisWorkbook.FullName)
    On Error Resume Next
    For i = 1 To ThisWorkbook.Worksheets.Count
        Set wks = ThisWorkbook.Worksheets(i)
        ' Διάλεξε ποια περίπτωση σε εξυπηρετεί καλύτερα
        ' NewName = xlFolder & wbName & "_" & wks.Name & ".pdf"
        ' NewName = xlFolder & wbName & "_" & wks.Index & ".pdf"
        NewName = xlFolder & Format(Date, "dd_mm_yyyy") & "_" & wbName & "_" & wks.Index & ".pdf"
        If fso.FileExists(NewName) Then
            fso.DeleteFile NewName
        End If
        If Err <> 0 Then
            MsgBox "Σφάλμα: " & Err & vbLf & Err.Description
            Exit Sub
        Else
            wks.ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    Filename:=NewName, _
                    Quality:=xlQualityMinimum, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
        End If
    Next
End Sub
Φιλικά

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση
  #8  
Παλιά 16-10-13, 08:24
Όνομα: Σωτήρης
Έκδοση λογισμικού Office: Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 26-05-2011
Περιοχή: Θεσσαλονίκη
Μηνύματα: 91
Προεπιλογή

δουλευει αψογα!!!!!!!!!!
αν και αυτο που θα πω ειναι εκτος topic. Ενα συμαντικο κομματι ακομα που μου εμεινε ειναι να κανω αναννεωση των δεδομενων στο φυλλο 1 (ετσι οπως το εχεις εσυ στο παραδειγμα σου) αν εχεις κατι σαν link για βοηθεια ευπροσδεκτο.
Ξεκιναω να το μελεταω και να το ψαχνω!!!

Και παλι ΕΥΧΑΡΙΣΤΩ ΠΑΡΑ ΠΟΛΥ!!!!
Απάντηση με παράθεση
Απάντηση στο θέμα


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

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


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

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[VBA] αποθήκευση ως pdf rmaria Excel - Ερωτήσεις / Απαντήσεις 16 22-12-20 20:06
[Εκτύπωση] Εκτύπωση με αποθήκευση? kolekas Excel - Ερωτήσεις / Απαντήσεις 25 08-10-15 16:20
[VBA] Αποθηκευση ως & μεταφορα κελιων kolekas Excel - Ερωτήσεις / Απαντήσεις 2 01-10-15 22:55
[VBA] μεταφορά και αποθήκευση δεδομένον rmaria Excel - Ερωτήσεις / Απαντήσεις 2 15-07-15 23:29
Υπολογισμός και αποθήκευση ΦΠΑ vaios84 Access - Ερωτήσεις / Απαντήσεις 8 24-01-12 12:16


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