sütundaki tanımlamadan dolayı msgbox uyarısı alma

[quixotic79]

[/url][/IMG]

merhaba arkadaşlar yapmak istediğim şey F Sütununda bulunan ve statüsü "Protokolü Bitiyor" ve "Protokolü Bitti" şeklinde olan plakaların (plakalar "B" sütununda olacak) Excel dosyası açılır açılmaz msgbox içerisinde uyarı vermesi, mümkünse önce "protokolü bitti" olanlar bir çarpı işareti ile versin, tamama basına bu kez "protokolü bitiyor" olanları bir ünlem isareti ile uyarsın... tekrar tamama basınca normal çalışma sayfamızda işimize devam edebilelim... bunla ilgili bir makro kodu yazacak olan arkadaşa şimdiden teşekkür ederim...

 

[hamitcan]

Kodu, ThisWorkBook kısmına ekleyin.

Private Sub Workbook_Open()
    For i = 2 To [f65536].End(3).Row
        If Sheets("Sayfa1").Cells(i, "f") = "Protokolü Bitti" Then
         MsgBox Sheets("Sayfa1").Cells(i, "b") & " plakanın protokolü bitti", vbCritical
         ElseIf Sheets("Sayfa1").Cells(i, "f") = "Protokolü Bitiyor" Then
         MsgBox Sheets("Sayfa1").Cells(i, "b") & " plakanın protokolü bitiyor", vbInformation
        End If
    Next
End Sub

 

[quixotic79]

teşekkürler kardeşim ...

 

[quixotic79]

bu şekilde her plaka için ayrı uyarı veriyor mesela diyelim 10 plakanın protokolü bitti 15 plaka bitiyor bunları 2 msgbox şeklinde verme şansımız var mı? çünkü liste bir hayli kalabalık olacak ta... yani msgbox sadece 2 tip olsa ve bu araçları orada toplasa...

 

[PLİNT]

bu şekilde her plaka için ayrı uyarı veriyor mesela diyelim 10 plakanın protokolü bitti 15 plaka bitiyor bunları 2 msgbox şeklinde verme şansımız var mı? çünkü liste bir hayli kalabalık olacak ta... yani msgbox sadece 2 tip olsa ve bu araçları orada toplasa...

Merhaba
Sn.Hamitcan'ın izniyle ekleme yapmaya çalıştım.
Aşağıdaki gibi denermisiniz?

Private Sub Workbook_Open()
  Application.Worksheets(1).Calculate
  A = " plakaların protokolü bitenler :" & vbCrLf
   B = " plakaların protokolü bitecekler :" & vbCrLf
   For i = 2 To [f65536].End(3).Row
        If Sheets("Sayfa1").Cells(i, "f") = "Bakımı Geçmiş" Then
A = A & Sheets("Sayfa1").Cells(i, "b") & vbCrLf
         ElseIf Sheets("Sayfa1").Cells(i, "f") = "Bakıma Çağır" Then
 B = B & Sheets("Sayfa1").Cells(i, "b") & vbCrLf
        End If
    Next
If A <> " plakaların protokolü bitenler :" & vbCrLf Then MsgBox A, vbInformation
If B <> " plakaların protokolü bitecekler :" & vbCrLf Then MsgBox B, vbInformation
End Sub

 

[quixotic79]

kardeşim eyvallah ikinizde çok yardımcı oldunuz ben örneklerinize bakarak bir iki düzenleme yaptım ve final haline geldi sadece vereceğim örnek dosya üzerinde yaparsanız değişikliği veya inceleyip bana kodu tekrar gönderirseniz çok makbule geçer... PLİNT verdiğin kodu düzenleyip uyguladım tam istediğim şey... sadece bir husus kaldı
1- listeleme yaparken ilk durumu, plakalar alt alta gelecek şekilde yapıyor sorun yok, ikinci uyarıda ise yani "Protokolü Bitti" durumunda plakaları yan yana bitişik yazıyor bunu düzeltemedim.

Private Sub Workbook_Open()
  Application.Worksheets(1).Calculate
  A = " protokolü bitmek üzere :" & vbCrLf
   B = " protokolü bitti :" & vbCrLf
   For i = 2 To [f65536].End(3).Row
        If Sheets("Sayfa1").Cells(i, "f") = "Protokolü Bitiyor" Then
A = A & Sheets("Sayfa1").Cells(i, "b") & vbCrLf
         ElseIf Sheets("Sayfa1").Cells(i, "f") = "Protokolü Bitti" Then
 B = B & Sheets("Sayfa1").Cells(i, "b") & vbCritical
        End If
    Next
If A <> " plakaların protokolü bitiyor :" & vbCrLf Then MsgBox A, vbInformation
If B <> " plakaların protokolü bitti :" & vbCrLf Then MsgBox B, vbCritical
End Sub

[/url][/IMG]
dosya linki
http://www.dosya.tc/server4/ezh8ww/deneme.rar.html

 

[PLİNT]

1- listeleme yaparken ilk durumu, plakalar alt alta gelecek şekilde yapıyor sorun yok, ikinci uyarıda ise yani "Protokolü Bitti" durumunda plakaları yan yana bitişik yazıyor bunu düzeltemedim.

Merhaba
Siz kodları düzenlerken yanlışlık yapmışsınız.
Aşağıdaki gibi kullanın, "sıra no" da ekleyecektir.

Private Sub Workbook_Open()
Application.Worksheets(1).Calculate
A = " protokolü bitmek üzere :" & vbCrLf
B = " protokolü bitti :" & vbCrLf
For i = 2 To [f65536].End(3).Row
 If Sheets("Sayfa1").Cells(i, "f") = "Protokolü Bitiyor" Then s = s + 1: A = A & s & ".  " & Sheets("Sayfa1").Cells(i, "b") & vbCrLf:
   If Sheets("Sayfa1").Cells(i, "f") = "Protokolü Bitti" Then n = n + 1: B = B & n & ".  " & Sheets("Sayfa1").Cells(i, "b") & vbCrLf:
Next
[COLOR="Red"]If A <> " protokolü bitmek üzere :" & vbCrLf Then MsgBox A, vbExclamation
If B <> " protokolü bitti :" & vbCrLf Then MsgBox B, vbCritical[/COLOR]
End Sub

 

[quixotic79]

çok teşekkür ederim kardeşim çok makbule geçti...

 

[PLİNT]

çok teşekkür ederim kardeşim çok makbule geçti...

Rica ederim kolay gelsin.
Son eklemiş olduğum koddaki düzeltilen kırmızı bölümü dikkate alınız.
Veri olmadığında mesaj ekranı çıkmasın.