Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [VBA] Χρωματισμός label μεγαλύτερου μικρότερου αριθμού (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/5869-xromatismos-label-megaliteroy-mikroteroy-arithmoi.html)

gfevran 20-04-21 10:42
Χρωματισμός label μεγαλύτερου μικρότερου αριθμού
 
1 Συνημμένο(α)
Καλημέρα σε όλου,
Σε μια userform με αριθμούς σε label να χρωματίζεται με διαφορετικό χρώμα το κελί
μεγαλύτερου μικρότερου αριθμού.

Θα ήθελα τη βοήθεια σας.

Ευχαριστώ

ChrisGT7 20-04-21 15:28
1 Συνημμένο(α)
Καλησπέρα Γιώργο,

Ελπίζω το συνημμένο αρχείο να καλύπτει τις ανάγκες σου.

gfevran 20-04-21 17:05
Καλησπέρα Χρήστο,
Σε' ευχαριστώ για την άμεση απάντηση
θα ήθελα οι τιμές στις label να μην αλλάζουν αλλά να παραμένουν σταθερές
κάθε φορά που ανοίγω και κλείνω τη userform!

ChrisGT7 20-04-21 18:02
Απλά σβήσε το παρακάτω κομμάτι κώδικα:
Κώδικας:
    For Each Lbl In Me.Controls
        If TypeName(Lbl) = "Label" Then Lbl.Caption = Int(101 * Rnd)
    Next

gfevran 20-04-21 19:45
Σε' Ευχαριστώ πολύ Χρήστο
Αυτό ήθελα δουλεύει τέλεια!

Με εκτίμηση
Γιώργος

gfevran 21-04-21 12:13
Καλημέρα,
Χρήστο, μια μικρή ακόμη βοήθεια αφορά τις τιμές στις ετικέτες,
όταν ο αριθμός είναι δεκαδικός τον αγνοεί δεν το χρωματίζει!
θα ήθελα τη βοήθεια σου

Ευχαριστώ

ChrisGT7 21-04-21 15:12
Καλησπέρα Γιώργο,

Αντικατέστησε τον κώδικα του αρχείου με τον παρακάτω:
Κώδικας:
Option Explicit

Private Sub UserForm_Initialize()
    Dim Lbl As Control, Min As Double, Max As Double
   
    For Each Lbl In Me.Controls
        If TypeName(Lbl) = "Label" Then
            If IsNumeric(CDbl(Lbl.Caption)) Then
                Min = CDbl(Lbl.Caption)
                Max = CDbl(Lbl.Caption)
                Exit For
            End If
        End If
    Next
   
    For Each Lbl In Me.Controls
        If TypeName(Lbl) = "Label" Then
            If IsNumeric(CDbl(Lbl.Caption)) Then
                If Lbl.Caption <= Min Then Min = CDbl(Lbl.Caption)
                If Lbl.Caption >= Max Then Max = CDbl(Lbl.Caption)
            End If
        End If
    Next
   
    For Each Lbl In Me.Controls
        If TypeName(Lbl) = "Label" Then
            If IsNumeric(CDbl(Lbl.Caption)) Then
                If Lbl.Caption = Min Then
                    Lbl.BackColor = vbGreen
                ElseIf Lbl.Caption = Max Then
                    Lbl.BackColor = vbRed
                End If
            End If
        End If
    Next
End Sub

gfevran 22-04-21 11:13
Καλημέρα,
Χρήστο Σε' Ευχαριστώ πολύ για το χρόνο σου,
Δουλεύει τέλεια, είναι αυτό ακριβώς που ήθελα!
Να' σε πάντα καλά.

Με Εκτίμηση
Γιώργος


Η ώρα είναι 11:11.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2