[VBA] Δημιουργία Μορφοποιημένου Φύλλου Εργασίας με κώδικα

[ΤΖΙΜΗΣ]

Θανάση θέλω αν γίνεται, με κώδικα VBA να δημιουργείτε ένα φύλλο εργασίας όπως αυτό το φύλλο ΠΡΟΣΦΟΡΑ το οποίο θα περιλαμβάνει εκείνα τα είδη που έχουν ποσότητες μη μηδενικές με βάση το πρώτο φύλλο.Το όνομα του νέου φύλλου που θα δημιουργείτε μπορεί να ορίζετε από τον κωδικα;

[Tasos]

Καλησπέρα σε όλους!

Δημήτρη, το ερώτημα σου είναι κατανοητό.

Όμως:
Ο προγραμματιστής, πριν προχωρήσει στη δημιουργία κάποιας ρουτίνας θα πρέπει να λάβει υπόψη του ΟΛΑ τα πιθανά σενάρια που θα οδηγούσαν σε σφάλμα και ενδεχομένως σε ανεπιθύμητα αποτελέσματα!

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

Για παράδειγμα:

• Από που θα πάρει η VBA την τιμή για να συμπληρωσει το κελί B2 στο νέο φύλλο;
• Τι όνομα θα δοθεί στο νέο φύλλο;
• Τι θα γίνει αν ήδη υπάρχει ήδη ένα φύλλο με το ίδιο όνομα;
• Τι θα γίνει αν το όνομα του φύλλου δεν μπορεί να περαστεί στο νέο φύλλο
  επειδή είναι μεγάλο ή επειδή περιέχει μη επιτρεπόμενους χαρακτήρες;

Δώσε μας μια απάντηση στα παραπάνω για να μπορέσουμε να σε βοηθήσουμε.

Φιλικά

Τάσος

[ΤΖΙΜΗΣ]

Τάσο ευχαριστώ για το ενδιαφέρον.Ειδικότερα:
1)Το όνομα για το κελί Β2 να το παίρνει από ένα inputForm
2) τό όνομα του φύλλου να είναι ίδιο με το κελί Β2
3) το όνομα να είναι αποδεκτό σύμφωνα με τις αρχές τις VBA (αποδεκτοί χαρακτήρες)
4) αν υπάρχει ήδη φύλλο με το ίδιο όνομα να το αντικαθιστά με το νέο.

[Tasos]

Γεια σου Δημήτρη!
Μετονόμασε το φύλλο "ΠΡΟΣΦΟΡΑ" σε "OfferTemplate" και απόκρυψε το.

Κατόπιν στο φύλλο "ΥΠΟΛΟΓΙΣΜΟΣ ΠΡΟΣΦΟΡΑΣ" αντιστοίχησε την ρουτίνα "NewOffer" στον παρακάτω κώδικα σε ένα κουμπί:

Option Explicit
Const ilegalChars = ":\/?*[]"

Sub NewOffer()
    Dim rng As Range, Wks As Worksheet, NewWks As Worksheet, _
        xPos As Integer, OfferName As String, SheetName As String
    Application.ScreenUpdating = False
    OfferName = VBA.InputBox("Δώσε Eπωνυμία", "Νέα προσφορά...")
    If StrPtr(OfferName) = 0 Then Exit Sub
    SheetName = CleanName(OfferName)
    xPos = NewSheetPosition(NewName:=SheetName)
    Set Wks = ActiveSheet
    Wks.Range("A:E").AutoFilter Field:=3, Criteria1:=">0", _
                                Operator:=xlAnd

    With ThisWorkbook.Worksheets("OfferTemplate")
        .Visible = xlSheetVisible
        .Copy After:=Sheets(xPos)
        .Visible = xlSheetHidden
    End With
    Set NewWks = ActiveSheet
    Set rng = Wks.AutoFilter.Range.Offset(1)
    rng.Copy
    With NewWks
        .Name = SheetName
        .Range("B1") = OfferName
        .Range("A5").PasteSpecial xlPasteValues
        .Range("A5").Select
    End With
    Wks.AutoFilterMode = False
    Application.CutCopyMode = False

End Sub

Function NewSheetPosition(NewName As String) As Integer
    Dim sh As Object, i As Integer
    For Each sh In ThisWorkbook.Sheets
        If sh.Name = NewName Then
            Application.DisplayAlerts = False
            sh.Delete
            Application.DisplayAlerts = True
        Else
            If sh.Visible Then i = i + 1
        End If
    Next
    NewSheetPosition = i
End Function

Function CleanName(strName As String) As String
    Dim i As Integer, tmpName As String
    tmpName = strName
    For i = 1 To Len(ilegalChars)
        tmpName = Replace(tmpName, Mid(ilegalChars, i, 1), "_")
    Next
    CleanName = tmpName
End Function

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

Τάσος

[ΤΖΙΜΗΣ]

Τάσο 'ίσως να σε κούρασα.Έκανα αυτό που μου είπες.Αποτέλεσμα το πρώτο φύλλο να μου εμφανίζει τα προιόντα που θέλω, ενώ εγώ το φύλλο αυτό δε θέλω να αλλάζει.Δημιουργία άλλου νέου φύλλου σύμφωνα με την επωνυμία που θέτω στην εισαγωγική φόρμα όπου θα εμφανίζει τα προιόντα με μη μηδενική τιμή δεν έκανε.
Μήπως κάτι κάνω στραβά;

[kapetang]

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

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

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

[ΤΖΙΜΗΣ]

Γιώργο έχεις απόλυτο δίκιο.Τάσο αυτό ακριβώς ήθελα.Πάντα δίνεις τρομερές λύσεις σε δύσκολα θέματα.Το ζητούμενο είναι πως και εμείς οι υπόλοιποι, θα μπορέσουμε να βελτιωθούμε ώστε να προσεγγίζουμε αυτά τα θέματα.
Να είσαι καλά.

[Tasos]

Καλησπέρα σε όλους!
Δημήτρη, χαίρομαι που σε βοηθήσαμε.
Αν ανήκεις στη μερίδα των προγραμματιστών/χρηστών που δεν αντιδρά αλλεργικά στο κουμπί F1,
θα αποκομίσεις πάρα πολλά από την βοήθεια των προγραμμάτων του Microsoft Office.

Αυτό ισχύει τόσο για την επιφάνεια εργασίας (πχ. συναρτήσεις στην Excel) όσο και το περιβάλλον VBE.

Ειδικά στο δεύτερο, μπορείς αφού βάλεις τον δρομέα πάνω σε κάποια λέξη του κώδικα να πατήσεις F1 για να σου εμφανιστεί η σχετική βοήθεια
συνοδευόμενη τις περισσότερες φορές από παραδειγματικό κώδικα.

Τα πράγματα απλουστεύονται περισσότερο αν μάθεις τα αντικείμενα πχ. της Excel, ξεκινώντας από αυτά που χρησιμοποιούνται συχνότερα.

Φυσικά μπορείς να επισπεύσεις αρκετά την εκμάθηση της Excel - VBA με τη βοήθεια μαθημάτων του τύπου Learning by Doing.

H ομάδα μας ( Ms-Office Development Team ) προετοιμάζει ήδη μια τέτοιου είδους ιντερνετική υπηρεσία.

Πιστεύω ότι σε μερικούς μήνες θα είμαστε έτοιμοι να προσφέρουμε μαθήματα OnLine σε ομάδες 1 έως 5 ατόμων.

Φιλικά

Τάσος

[ΤΖΙΜΗΣ]

Τάσο για δες το θέμα που έθεσα για δημόσια διαβούλευση