[Μορφοποίηση] Μορφοποίηση σε νόμισμα

[Gogosbmx]

Γεια σας. Μήπως υπάρχει τρόπος γράφοντας στο κελί ένα ποσό παραλείποντας το κόμμα (,) και να το παίρνει αυτόματα? Παράδειγμα : Θέλω να γράφω στο κελί 15434 και να πατάω enter και αυτό να μου γράφει αυτόματα 154,34 €

Βοήθεια ?
Ευχαριστώ εκ των προτέρων

[Tasos]

Καλησπέρα Γιώργο!

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

Πήγαινε στις επιλογές του Excel > Για προχωρημένους και τσέκαρε το πλαίσιο ελέγχου με την ετικέτα: Αυτόματη εισαγωγή υποδιαστολής.

Προσοχή! Η επιλογή της Αυτόματης εισαγωγής υποδιαστολής ισχύει για όλα βιβλία που θα ανοιχτούν.

Μια άλλη λύση θα ήταν η χρήση κώδικα VBA με την προϋπόθεση ότι οι μακροεντολές στην εφαρμογή θα πρέπει να είναι ενεργοποιημένες.

Επίσης η λύση με VBA ακυρώνει τη δυνατότητα αναίρεσης ενεργειών του βιβλίου εργασίας.

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

Στο παράθυρο που θα εμφανιστεί επικόλλησε τον παρακάτω κώδικα:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Row < 1 Then Exit Sub
    If IsNumeric(Target.Value) Then
        Select Case Target.Column
        'Προσάρμοσε παρακάτω τα νούμερα των στηλών
        'όπου θα εφαρμόζεται η εισαγωγή υποδιαστολής.
            Case 2, 3, 4, 5, 6, 7  '<---τα νούμερα των στηλών
                Application.EnableEvents = False
                Target.Value = Target.Value / 100
                Application.EnableEvents = True
        End Select
    End If
End Sub

Ο κώδικας αυτός τρέχει αυτόματα κάθε φορά που θα αλλάξει η τιμή ενός κελιού στις
στήλες 2, 3, 4, 5, 6, 7 και μετά την πρώτη γραμμή.

Μπορείς να προσθέσεις ή να αφαιρέσεις νούμερα στηλών στον κώδικα διατηρώντας πάντα την σύνταξη όπως φαίνεται παραπάνω.

Μορφοποίησε τις στήλες με μορφή αριθμού "νομισματική μονάδα"
.
Καλή συνέχεια!

Τάσος

[Gogosbmx]

Αρχική Δημοσίευση από Tasos

Καλησπέρα Γιώργο!

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

Πήγαινε στις επιλογές του Excel > Για προχωρημένους και τσέκαρε το πλαίσιο ελέγχου με την ετικέτα: Αυτόματη εισαγωγή υποδιαστολής.

Προσοχή! Η επιλογή της Αυτόματης εισαγωγής υποδιαστολής ισχύει για όλα βιβλία που θα ανοιχτούν.

Μια άλλη λύση θα ήταν η χρήση κώδικα VBA με την προϋπόθεση ότι οι μακροεντολές στην εφαρμογή θα πρέπει να είναι ενεργοποιημένες.

Επίσης η λύση με VBA ακυρώνει τη δυνατότητα αναίρεσης ενεργειών του βιβλίου εργασίας.

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

Στο παράθυρο που θα εμφανιστεί επικόλλησε τον παρακάτω κώδικα:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Row < 1 Then Exit Sub
    If IsNumeric(Target.Value) Then
        Select Case Target.Column
        'Προσάρμοσε παρακάτω τα νούμερα των στηλών
        'όπου θα εφαρμόζεται η εισαγωγή υποδιαστολής.
            Case 2, 3, 4, 5, 6, 7  '<---τα νούμερα των στηλών
                Application.EnableEvents = False
                Target.Value = Target.Value / 100
                Application.EnableEvents = True
        End Select
    End If
End Sub

Ο κώδικας αυτός τρέχει αυτόματα κάθε φορά που θα αλλάξει η τιμή ενός κελιού στις
στήλες 2, 3, 4, 5, 6, 7 και μετά την πρώτη γραμμή.

Μπορείς να προσθέσεις ή να αφαιρέσεις νούμερα στηλών στον κώδικα διατηρώντας πάντα την σύνταξη όπως φαίνεται παραπάνω.

Μορφοποίησε τις στήλες με μορφή αριθμού "νομισματική μονάδα"
.
Καλή συνέχεια!

Τάσος

Ευχαριστώ
Με βοηθάει εν μέρει με το κώδικα όχι με την ρύθμιση. Το ιδανικό θα ήταν να γίνεται μόνο σε κάποια συγκεκριμένα κελιά τα οποία δεν έιναι στην ίδια σειρά η στήλη αλλα άν δεν γίνεται και πάλι ευχαριστώ

[Tasos]

Γιώργο στο συνημμένο παράδειγμα υπάρχουν δύο προσεγγίσεις που καλύπτουν το ζητούμενο

Στο φύλλο Περιοχές κελιών υπάρχουν περιοχές (με κίτρινο φόντο) στις οποίες έχουν δοθεί τα ονόματα : NameOfRange1, NameOfRange2, NameOfRange3, NameOfRange4 και NameOfRange5.
Ο κώδικας που επιτρέπει την εισαγωγή υποδιαστολής είναι:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CanRun As Boolean
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Row < 1 Then Exit Sub
    If IsNumeric(Target.Value) Then
        If Target.Value <> 0 Then
            If Not Intersect(Target, Range("NameOfRange1")) Is Nothing Or _
               Not Intersect(Target, Range("NameOfRange2")) Is Nothing Or _
               Not Intersect(Target, Range("NameOfRange3")) Is Nothing Or _
               Not Intersect(Target, Range("NameOfRange4")) Is Nothing Or _
               Not Intersect(Target, Range("NameOfRange5")) Is Nothing Then
                Application.EnableEvents = False
                Target.Value = Target.Value / 100
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

Στο φύλλο Διευθύνσεις κελιών υπάρχουν μεμονωμένα κελιά (επίσης με κίτρινο φόντο για καλύτερη σήμανση) με διευθύνσεις: "A3", "B4", "C5", "D8", "D10" και "D15"
Ο κώδικας που επιτρέπει την εισαγωγή υποδιαστολής στο φύλλο αυτό είναι:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Row < 1 Then Exit Sub
    If IsNumeric(Target.Value) Then
        If Target.Value <> 0 Then
            Select Case Target.Address(False, False)
                Case "A3", "B4", "C5", "D8", "D10", "D15"
                    Application.EnableEvents = False
                    Target.Value = Target.Value / 100
                    Application.EnableEvents = True
            End Select
        End If
    End If
End Sub

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

Τάσος

[Gogosbmx]

Τέλεια !!

Ευχαριστώ για τον χρόνο που αφιερώσατε να με βοηθήσετε

Ότι ήθελα

[Tasos]

Να είσαι καλά Γιώργο!

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

Τάσος