Hücre rengine göre MsgBox

muratgunay48 · 30 Ocak 2025

Arkadaşlar, sayın hocalarım, söylemiştim Sudoku tamamlamaya çalışıyorum. @Muzaffer Ali hocamın yazdığı şöyle bir kod var. Ben ona MsgBox ekledim ama hem daha güzel hem anlamlı olması açısından. Koşullu MsgBox yapmak mümkün mü?
Yani karşılaştırmayı yaptı. Seçili alan içinde Kırmızı hücre varsa "Üzgünüm yapamadınız" yazacak. Kırmızı hücre yoksa "Tebrikler" yazacak. Mümkün mü?
Şimdiden teşekkür ederim.
Saygılarımla.

Kod:

Sub Test()
    Dim Adres As String
    Dim Bak As Range

    Adres = "B2:J10"
    For Each Bak In Worksheets("Sudoku").Range(Adres)

        If Bak <> Worksheets("Solution").Range(Bak.Address) Then
            Bak.Interior.Color = 255
        End If
    Next
    With Worksheets("Sudoku").Range(Adres)
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.ColorIndex = 0
        .Interior.PatternTintAndShade = 0
    End With
    With Worksheets("Solution").Range(Adres).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With
    
        MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & _
           "Kırmızı renkli hücreler yanlışlığı ifade eder." & Chr(10) & Chr(10) & _
           "Kırmızı hücre yoksa TEBRİKLER.", vbInformation, "muratgunay48"
          
End Sub

DoğanD · 31 Ocak 2025

Merhaba,

Bir boolean değişken tanımlayarak kontrol esnasında kırmızıya boyadığınız satırın altında değerini True olarak değiştirin. Ardından;
En başa;
dim KontDegisken as Boolean
KontDegisken = false

Kırmızıya boyadığınız satırın altına
KontDegisken = true

mesaj kısmına
if KontDegisken = true then
mesaj = "Üzgünüm Yapamadınız"
else
mesaj = "tebrikler"
end if
msgbox mesaj

Muzaffer Ali · 31 Ocak 2025

Merhaba.

Kod:

Sub Test()
    Dim Adres As String
    Dim Bak As Range
    Dim Tamamlandi As Boolean
    Adres = "B2:J10"
    For Each Bak In Worksheets("Sudoku").Range(Adres)

        If Bak <> Worksheets("Solution").Range(Bak.Address) Then
            Bak.Interior.Color = 255
            Tamamlandi = False
        End If
    Next
    With Worksheets("Sudoku").Range(Adres)
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.ColorIndex = 0
        .Interior.PatternTintAndShade = 0
    End With
    With Worksheets("Solution").Range(Adres).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With
    
    If Tamamlandi Then
        MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Tebrikler tamamladınız."
    Else
        MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Üzgünüm yapamadınız."
    End If
          
End Sub

muratgunay48 · 31 Ocak 2025

Muzaffer Ali' Alıntı:

Merhaba.

Kod:

Sub Test()
    Dim Adres As String
    Dim Bak As Range
    Dim Tamamlandi As Boolean
    Adres = "B2:J10"
    For Each Bak In Worksheets("Sudoku").Range(Adres)

        If Bak <> Worksheets("Solution").Range(Bak.Address) Then
            Bak.Interior.Color = 255
            Tamamlandi = False
        End If
    Next
    With Worksheets("Sudoku").Range(Adres)
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.ColorIndex = 0
        .Interior.PatternTintAndShade = 0
    End With
    With Worksheets("Solution").Range(Adres).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With
   
    If Tamamlandi Then
        MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Tebrikler tamamladınız."
    Else
        MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Üzgünüm yapamadınız."
    End If
         
End Sub

Çok teşekkür ederim hocam. Emeğinize sağlık.

hamitalper · 5 Şubat 2025

Murat Bey merhaba dosyayı bizlerle paylaşma şansınız varmı

muratgunay48 · 5 Şubat 2025

hamitalper' Alıntı:
Murat Bey merhaba dosyayı bizlerle paylaşma şansınız varmı

Elbette, az bir kaldı. Paylaşım olarak paylaşacağım.

muratgunay48 · 5 Şubat 2025

Muzaffer Ali' Alıntı:

Merhaba.

Kod:

Sub Test()
    Dim Adres As String
    Dim Bak As Range
    Dim Tamamlandi As Boolean
    Adres = "B2:J10"
    For Each Bak In Worksheets("Sudoku").Range(Adres)

        If Bak <> Worksheets("Solution").Range(Bak.Address) Then
            Bak.Interior.Color = 255
            Tamamlandi = False
        End If
    Next
    With Worksheets("Sudoku").Range(Adres)
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.ColorIndex = 0
        .Interior.PatternTintAndShade = 0
    End With
    With Worksheets("Solution").Range(Adres).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With
   
    If Tamamlandi Then
        MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Tebrikler tamamladınız."
    Else
        MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Üzgünüm yapamadınız."
    End If
         
End Sub

Hocam, hiç kırmızı hücre olmamasına rağmen "Üzgünüm yapamadınız" diyor. Neden kaynaklanabilir. Hatta dosyayı atayım hocam.

Muzaffer Ali · 6 Şubat 2025

Bu kodu deneyin.

Kod:

Sub test()
    Dim Adres As String
    Dim Bak As Range
    Dim Tamamlandi As Boolean
    Dim BosVar As Boolean
    
    Adres = "B2:J10"
    Tamamlandi = True

    For Each Bak In Worksheets("Sudoku").Range(Adres)
        If Bak <> Worksheets("Solution").Range(Bak.Address) Then
            Bak.Interior.Color = 255
            Tamamlandi = False
        End If
        If IsEmpty(Bak) Then
            BosVar = True
        End If
    Next
    With Worksheets("Sudoku").Range(Adres)
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.ColorIndex = 0
        .Interior.PatternTintAndShade = 0
    End With
    With Worksheets("Solution").Range(Adres).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With
    
    If Tamamlandi Then
        MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Tebrikler tamamladınız.", vbInformation, "muratgunay48"
    Else
        If BosVar Then
            MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Tebrikler hata yok fakat bulmaca tamamlanmamıştır.", vbInformation, "muratgunay48"
        Else
            MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Üzgünüm yapamadınız.", vbInformation, "muratgunay48"
        End If
    End If
End Sub

muratgunay48 · 6 Şubat 2025

Muzaffer Ali' Alıntı:

Bu kodu deneyin.

Kod:

Sub test()
    Dim Adres As String
    Dim Bak As Range
    Dim Tamamlandi As Boolean
    Dim BosVar As Boolean
   
    Adres = "B2:J10"
    Tamamlandi = True

    For Each Bak In Worksheets("Sudoku").Range(Adres)
        If Bak <> Worksheets("Solution").Range(Bak.Address) Then
            Bak.Interior.Color = 255
            Tamamlandi = False
        End If
        If IsEmpty(Bak) Then
            BosVar = True
        End If
    Next
    With Worksheets("Sudoku").Range(Adres)
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.ColorIndex = 0
        .Interior.PatternTintAndShade = 0
    End With
    With Worksheets("Solution").Range(Adres).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With
   
    If Tamamlandi Then
        MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Tebrikler tamamladınız.", vbInformation, "muratgunay48"
    Else
        If BosVar Then
            MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Tebrikler hata yok fakat bulmaca tamamlanmamıştır.", vbInformation, "muratgunay48"
        Else
            MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Üzgünüm yapamadınız.", vbInformation, "muratgunay48"
        End If
    End If
End Sub

Hocam, çok teşekkür ederim. Emeğinize sağlık. Başarılı bir şekilde çözmeden cevap yazamadım

muratgunay48 · 6 Şubat 2025

Muzaffer Ali' Alıntı:

Bu kodu deneyin.

Kod:

Sub test()
    Dim Adres As String
    Dim Bak As Range
    Dim Tamamlandi As Boolean
    Dim BosVar As Boolean
   
    Adres = "B2:J10"
    Tamamlandi = True

    For Each Bak In Worksheets("Sudoku").Range(Adres)
        If Bak <> Worksheets("Solution").Range(Bak.Address) Then
            Bak.Interior.Color = 255
            Tamamlandi = False
        End If
        If IsEmpty(Bak) Then
            BosVar = True
        End If
    Next
    With Worksheets("Sudoku").Range(Adres)
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.ColorIndex = 0
        .Interior.PatternTintAndShade = 0
    End With
    With Worksheets("Solution").Range(Adres).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
    End With
   
    If Tamamlandi Then
        MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Tebrikler tamamladınız.", vbInformation, "muratgunay48"
    Else
        If BosVar Then
            MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Tebrikler hata yok fakat bulmaca tamamlanmamıştır.", vbInformation, "muratgunay48"
        Else
            MsgBox "Kontrol tamamlanmıştır." & Chr(10) & Chr(10) & "Üzgünüm yapamadınız.", vbInformation, "muratgunay48"
        End If
    End If
End Sub

Hocam sadece " hr(10) & "Tebrikler hata yok fakat bulmaca tamamlanmamıştır.", vbInformation, " kısmını
hr(10) & "Tüm kareler doldurulmalıdır", vbInformation, Şeklinde değiştirdim.

Hücre rengine göre MsgBox

muratgunay48

DoğanD

Muzaffer Ali

Destek Ekibi

muratgunay48

hamitalper

muratgunay48

muratgunay48

Ekli dosyalar

Muzaffer Ali

Destek Ekibi

muratgunay48

muratgunay48