• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

sadece 1 kez uyarı mesajı verdirmek

M

metin_0606

Katılım
1 Ağustos 2019
Mesajlar
839
Excel Vers. ve Dili
Türkçe excel 2016
İngilizce excel 2016
İlgili sayfaya her girişimde günü gelen uyarıların mesajlarını verdiriyorum. Bu kodu sayfaya her girişimde değil de, sayfaya kaç kez girersem gireyim sadace 1 defa versin, bir daha vermesin istiyorum. Bunu nasıl yaparım acaba Aktif sayfaya bağlı kod sayısı toplam 9 adettir
Private Sub Worksheet_Activate()
takvim
OGKK
sozlesme
Azonesozlesme
B_zonesozlesme
C_zonesozlesme
D_zonesozlesme
merkezofissozlesme
misafirotopark
On Error Resume Next
bulunan = ""
Bul = Worksheets("AJANDA").Range("B2:B100").Find(Date).Row
If Bul > 0 Then
With Sheets("AJANDA").Range("B2:B100")
Set c = .Find(Date)
If Not c Is Nothing Then
firstAddress = c.Address
Do
bulunan = bulunan & Sheets("AJANDA").Cells(c.Row, 1) & " --> " & c.Text & Chr(13)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
MsgBox bulunan, vbInformation, "Hatırlanması Gerekenler"
End If
End Sub
 
Merhaba,

Dosyanıza boş bir modül ekleyin ve modüle aşağıdaki kod satırını uygulayın.

Kod: 
Public Kontrol As Boolean

Kendi kodlarınızı da aşağıdaki yapı gibi düzenleyiniz.

Kod: 
Private Sub Worksheet_Activate()
    If Kontrol = True Then Exit Sub
    Rem Kodlarınız...
    Rem Kodlarınız...
    Rem Kodlarınız...
    MsgBox "Test"
    Kontrol = True
End Sub
 
Korhan Ayhan' Alıntı:
Merhaba,

Dosyanıza boş bir modül ekleyin ve modüle aşağıdaki kod satırını uygulayın.

Kod: 
Public Kontrol As Boolean

Kendi kodlarınızı da aşağıdaki yapı gibi düzenleyiniz.

Kod: 
Private Sub Worksheet_Activate()
    If Kontrol = True Then Exit Sub
    Rem Kodlarınız...
    Rem Kodlarınız...
    Rem Kodlarınız...
    MsgBox "Test"
    Kontrol = True
End Sub
Genişletmek için tıkla ...
Korhan bey Rem den sonra kodların sadece başlığınımi yoksa tamamını mı yazacağız tamamını yazacak olursak eğer her birinin mesaj içeriği farklı o durumda MSG box larin her birini buraya ekleyecekmiyiz
 
Diğer çağırdığınız makroların içinde demi MsgBox var.

Eğer durum böyleyse nasıl bir kurgu düşünüyorsunuz.
 
Aynen diğer makrolarin icindede içerikleri farklı uyarı mesajları var yani belirtilen tarihe gelindiğinde yada sözleşme sayısını geçince uyari mesajı alıyorum
 
Sayfayı aktif ettiğinizde kaç adet msgbox karşınıza çıkıyor?
 
Korhan bey zamanı gelince uyaracak olan 10 adet msg boxum var kimisi örneğin şu isimli projenin sözleşmesinin bitimine bir aylık süre kaldı diyor kimisi kimlik kartı süresi yedi gün sonra bitecek personel isim listesi olarak olarak uyarı veriyor bunları label ve listbox kullanarak yaptim
 
uyarı mesajı verdirdiğim kodlar şu şekilde
Private Sub UserForm_Initialize()
Me.Caption = "SOZLESME HATIRLATICISI!"
Label1.Caption = Format(Date, " dd.mm.yyyy") & " SOZLESMEYI SÝTEME GIRMEK ICIN 7 GÜNLÜK SURENIZ KALMISTIR !!! "
End Sub

Sub OGKK()
On Error Resume Next
Dim hcr As Range, sat As Long, var As Boolean
sat = Sheets("ANA SAYFA").Cells(65536, "U").End(xlUp).Row
If sat < 2 Then Exit Sub
For Each hcr In Sheets("ANA SAYFA").Range("U2:U" & sat)
If hcr.Value = 7 Then
UserForm3.ListBox1.AddItem hcr.Offset(0, -18).Value
var = True
End If
Next
If var = True Then UserForm3.Show
End Sub
buna benzer 10 userform var
 
Aşağıdaki gibi deneyiniz.

Dosyanıza boş bir modül ekleyin ve modüle aşağıdaki kod satırını uygulayın.

Kod: 
Public Kontrol As Boolean


Kod: 
Private Sub Worksheet_Activate()
If Kontrol = True Then Exit Sub
takvim
OGKK
sozlesme
Azonesozlesme
B_zonesozlesme
C_zonesozlesme
D_zonesozlesme
merkezofissozlesme
misafirotopark
On Error Resume Next
bulunan = ""
Bul = Worksheets("AJANDA").Range("B2:B100").Find(Date).Row
If Bul > 0 Then
With Sheets("AJANDA").Range("B2:B100")
Set c = .Find(Date)
If Not c Is Nothing Then
firstAddress = c.Address
Do
bulunan = bulunan & Sheets("AJANDA").Cells(c.Row, 1) & " --> " & c.Text & Chr(13)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
MsgBox bulunan, vbInformation, "Hatırlanması Gerekenler"
End If
Kontrol = True
End Sub
 
Korhan bey çok teşekkür ederim kod gayet güzel çalışıyor labele yazdığım uyarı mesajindaki kalan gün sayısını elimle manuel yazıyorum bunu otomatik olarak kendi atabilirmi mesaj içine acaba
 
Hangi tarihle kıyaslama yapılacak?
 
Personel İcmal sayfasının w8-w15 satırlarında sözleşmenin kalan gün sayısı yazmakta bunu formül hesaplamakta Ana Sayfanın u2-u10000 arasindada kimlik kartının kalan gün sayısı yazmakta bunu da formül hesaplamakta
 
Örnek dosyanızı paylaşırsanız konuyu daha net anlayacağım.
 
Korhan hocam örnek bir liste hazırlar paylaşırım labele elle yazdığım uyarı mesajlarıni otomatik yazacak yedin gün kala sözleşmenin bitimine 7 gün kaldı diye labele yazacak
 
Eklediğiniz dosyada aynı anda hem 7 gün, hem 6 gün, hem 5 gün ve böyle giden kayıtlar varsa durum ne olacak?
 
O zaman sayfa aktif olunca üst üste uyarı mesajları gelecek ben okuduğumu kapatıp alttaki uyarı mesajını okuyacağım önemli olan bir hafta içinde hangi projenin sözleşmesinin bitimine kaç gün kaldığını görebilmek
Korhan Ayhan' Alıntı:
Eklediğiniz dosyada aynı anda hem 7 gün, hem 6 gün, hem 5 gün ve böyle giden kayıtlar varsa durum ne olacak?
Genişletmek için tıkla ...
 
UserForm1 kod bölümünü (Initialize bölümünü) silip aşağıdaki kodu deneyiniz.

Kod: 
Sub sozlesme()
    On Error Resume Next
    Dim hcr As Range, sat As Long, var As Boolean, deg As Byte
    deg = 7
    sat = Sheets("Personel Icmal").Cells(65536, "D").End(xlUp).Row
    If sat < 2 Then Exit Sub
    For Each hcr In Sheets("Personel Icmal").Range("D2:D" & sat)
      If hcr.Value = 7 Then
        UserForm1.ListBox1.AddItem hcr.Offset(0, -3).Value
        var = True
     End If
    Next
    If var = True Then
        UserForm1.Caption = "SÖZLEŞME HATIRLATICISI!"
        UserForm1.Label1.Caption = "BUGÜN İTİBARI İLE ASAGIDA BELİRTİLEN PROJENİN SÖZLEŞME BİTİMİNE " & deg & " GÜN KALMIŞTIR."
        UserForm1.Show
    End If
End Sub
 
Denedim Korhan bey ama sürekli sözleşme günü 5 günde kalsa 7 gün kaldı diyor yani 7 sayısı sabitlenmiş sanırım <=7 yaptım yine olmadi
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst