sulos
Altın Üye
- Katılım
- 20 Temmuz 2009
- Mesajlar
- 60
- Excel Vers. ve Dili
- MS Office LTSC Standard 2021
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Teşekkürler Hocam.Tamam o satırı silebilirsiniz.
Korhan Bey üstadım bu çalışmada bugünden önce bir tarih seçilmesi halinde msgbox uyarısı verilmesi için kodlara nasıl bir ekleme yapmak gerekir. teşekkürler...Dosyanıza takvim uygulamasını ekledim. İlgili hücre aralığında hücre seçtiğinizde takvim otomatik açılacaktır.
Public WithEvents CMDB As MSForms.CommandButton
Private Sub CMDB_Click()
Dim Tarih As Date
If Form_Takvim.ComboBox1 = "" Then
MsgBox "Yıl değeri hatalı girilmiş!" & Chr(10) & "Lütfen kontrol ediniz!", vbCritical
Form_Takvim.ComboBox1.SetFocus
Exit Sub
End If
If Form_Takvim.ComboBox2 = "" Then
MsgBox "Ay değeri hatalı girilmiş!" & Chr(10) & "Lütfen kontrol ediniz!", vbCritical
Form_Takvim.ComboBox2.SetFocus
Exit Sub
End If
Tarih = DateSerial(Form_Takvim.ComboBox1, Form_Takvim.ComboBox2.ListIndex + 1, CMDB.Caption)
If Tarih < Date Then
MsgBox "Bugünden önceki bir tarihi seçemezsiniz!" & Chr(10) & "Lütfen kontrol ediniz!", vbCritical
Form_Takvim.ComboBox2.SetFocus
Exit Sub
End If
Unload Form_Takvim
ActiveCell = Format(CDate(Tarih), "dd.mm.yyyy")
ActiveCell.EntireColumn.AutoFit
End Sub
Public WithEvents CMDB As MSForms.CommandButton
Private Sub CMDB_Click()
Dim Tarih As Date
If Form_Takvim.ComboBox1 = "" Then
MsgBox "Yıl değeri hatalı girilmiş!" & Chr(10) & "Lütfen kontrol ediniz!", vbCritical
Form_Takvim.ComboBox1.SetFocus
Exit Sub
End If
If Form_Takvim.ComboBox2 = "" Then
MsgBox "Ay değeri hatalı girilmiş!" & Chr(10) & "Lütfen kontrol ediniz!", vbCritical
Form_Takvim.ComboBox2.SetFocus
Exit Sub
End If
Tarih = DateSerial(Form_Takvim.ComboBox1, Form_Takvim.ComboBox2.ListIndex + 1, CMDB.Caption)
Unload Form_Takvim
If Selection.Cells.Count = 1 Then
ActiveCell = CDate(Format(Tarih, "dd.mm.yyyy"))
ActiveCell.EntireColumn.AutoFit
Else
Selection.NumberFormat = "dd.mm.yyyy"
Selection = CDate(Tarih) + 0
Selection.EntireColumn.AutoFit
End If
End Sub