VBA takvim hatası

behyay · 23 Mayıs 2020

Merhaba Halit3 Üstadım,
Zatı alinizin hazırlamış olduğu ekli kodu programlarımda hep kullandım. Allah razı olsun.Size minnettarım.
Lakin bu yıl takvim hata verdi. Dini bayram günlerini bir gün öncesini boyama yapıyor. Ben tatil günlerini otomatik olarak renklendiriyorum. Ekli linkte ki takvimde görebilirsiniz.
Örneğin bu Ramazan Bayramında ilk günü 22, son gününü ise 25 mayıs olarak renklendiriyor.Aynı hatayı Kurban Bayramında da yapıyor.takvim
Artık yıldan mı kaynaklandı bilmiyorum.Rica etsem bir el atmanız mümkün mü?
Bayramınız mübarek olsun.Saygılarımla.

Kod:

Dim deg1 As String
Dim deg2 As String
Const aylar1 = "b1" 'AY
Const yillar1 = "b2" 'YIL
Private Sub CommandButton1_Click()
CommandButton2_Click
Dim m As Date
Dim j As Long
Dim yer1 As String, yillar As String, aylar As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

sat1 = 6 'yazmaya başlıyacağı ilk satır

sut1 = 4 'yazmaya başlıyacağı ilk sutun

'sat2 = Cells(Rows.Count, "c").End(3).Row 'yazmaya başlıyacağı son satır
sat2 = Cells(Rows.Count, "c").End(3).Row 'yazmaya başlıyacağı son satır

sut2 = "ah" 'yazmaya başlıyacağı son sutun
'son1 = Cells(Rows.Count, "c").End(3).Row 'satır sayısı buradan ayarlanır 16 yazarsak 14/15/16.satırlara oluşturur
son1 = 7 'satır sayısı buradan ayarlanır 16 yazarsak 14/15/16.satırlara oluşturur

'Range(Cells(sat1, sut1), Cells(sat2, sut2)).ClearContents

Range("d13:Ah159").Select
Selection.ClearContents

Range(Cells(sat1, sut1), Cells(sat2, sut2)).Interior.ColorIndex = xlNone

If sat1 > 0 Then
'Range(Cells(sat1, sut1), Cells(sat2, sut2)).Value = Cells(14, 3).Value 'diğer günleri .... ile doldur
Range(Cells(sat1, sut1), Cells(sat2, sut2)).Value = 6 'diğer günleri 6 ile doldur
Else
Range(Cells(sat1, sut1), Cells(sat2, sut2)).Value = ""
End If


Cells(13, 35).Value = "TOPLAM"
Cells(13, 36).Value = "İMZA"

aylar = Range(aylar1).Value
yillar = Range(yillar1).Value
yer1 = Val(Format("01." & Format(aylar, "00") & "." & Format(yillar, "0000"), "mm"))
Ayin_Son_Gunu = DateSerial(yillar, yer1 + 1, 1) - 1
Ayin_Ilk_Gunu = DateSerial(yillar, yer1, 1)
son = Val(Format(Ayin_Son_Gunu, "dd"))

For j = 1 To son
m = CDate(Format(j, "00") & "." & Format(aylar, "00") & "." & Format(yillar, "0000"))
Hicri_takvim1 (m)
Cells(sat1, sut1 + j - 1).Value = Format(j, "00") & " " & Format(m, "DDDD")


If Format(m, "DDDD") = "Pazar" Or Format(m, "DDDD") = "Cumartesi" Then
Cells(sat1, sut1 + j - 1).Interior.ColorIndex = 3
For r = 14 To son1
Cells(r, sut1 + j - 1).Interior.ColorIndex = 3
Cells(r, sut1 + j - 1).Value = 0 'haftasonlarını 0 göster

Next r
End If

If deg1 <> "" Or deg2 <> "" Then
Cells(sat1, sut1 + j - 1).Interior.ColorIndex = 8
For r = 14 To son1
Cells(r, sut1 + j - 1).Interior.ColorIndex = 8
Cells(r, sut1 + j - 1).Value = 0 'tatilgünlerni 0 göster

Next r
End If

Next

MsgBox "LÜTFEN ARTAN GÜNLERİNDEKİ RAKAMLARI SİLİNİZ.! ", , "UYARI !!"

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Sub Hicri_takvim1(TRH)
deg2 = ""
If Month(TRH) = 1 And Day(TRH) = 1 Then deg2 = "Yılbaşı"
If Month(TRH) = 4 And Day(TRH) = 23 Then deg2 = "Ulusal Egemenlik Çocuk Bayramı"
If Month(TRH) = 5 And Day(TRH) = 1 Then deg2 = "İşçi Bayramı"
If Month(TRH) = 5 And Day(TRH) = 19 Then deg2 = "Gençlik ve Spor Bayramı"
If Month(TRH) = 7 And Day(TRH) = 15 Then deg2 = "Demokrasi ve Milli Birlik Günü"
If Month(TRH) = 8 And Day(TRH) = 30 Then deg2 = "Zafer Bayramı"
If Month(TRH) = 10 And Day(TRH) = 28 Then deg2 = "Cumhuriyetin Bayramı Yarım gün"
If Month(TRH) = 10 And Day(TRH) = 29 Then deg2 = "Cumhuriyetin Bayramı"
Calendar = vbCalHijri
deg1 = ""
If Month(TRH) = 9 And Day(TRH) = 30 Then deg1 = "Ramazan Bayramı Arife.günü Yarım gün"
If Month(TRH) = 10 And Day(TRH) = 1 Then deg1 = "Ramazan Bayramı 1.günü"
If Month(TRH) = 10 And Day(TRH) = 2 Then deg1 = "Ramazan Bayramı 2.günü"
If Month(TRH) = 10 And Day(TRH) = 3 Then deg1 = "Ramazan Bayramı 3.günü"

If Month(TRH) = 12 And Day(TRH) = 9 Then deg1 = "Kurban Bayramı Arife.günü Yarım gün"
If Month(TRH) = 12 And Day(TRH) = 10 Then deg1 = "Kurban Bayramı 1.günü"
If Month(TRH) = 12 And Day(TRH) = 11 Then deg1 = "Kurban Bayramı 2.günü"
If Month(TRH) = 12 And Day(TRH) = 12 Then deg1 = "Kurban Bayramı 3.günü"
If Month(TRH) = 12 And Day(TRH) = 13 Then deg1 = "Kurban Bayramı 4.günü"
Calendar = vbCalGreg
End Sub

Private Sub CommandButton2_Click()
aylar = Range(aylar1).Value
yillar = Range(yillar1).Value
If aylar = "" Or yillar = "" Then
MsgBox "İlgili ay veya yılı seçmediniz " & aylar1 & " veya " & yillar1 & " hücrelerine ay ve yılı yazınız."
End
End If
If IsNumeric(aylar) <> False Then
MsgBox "İlgili ayı " & aylar1 & " hücresine yazı olarak giriniz veya listeden seçiniz."
End
End If
If IsNumeric(yillar) <> True Then
MsgBox "İlgili yılı " & yillar1 & " hücresine sayısal olarak yazınız."
End
End If
Gun = 0
For t = 1 To 12
yer = Format("01." & Format(t, "00") & "." & yillar, "mmmm")
If aylar = yer Then
Gun = t
Exit For
End If
Next

If Gun = 0 Then
MsgBox "İlgili ayı " & aylar1 & " hücresine yazı olarak ay ismi giriniz."
End
End If
If yillar < 1900 Or yillar > 2100 Then
MsgBox "Yıl için " & yillar1 & " Hücresine Lütfen 1900 - 2100 arası bir sayı giriniz."

End
End If
say
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
say
End Sub
Sub say()
Dim i As Integer, sayi As Integer

Sheets("KADROLU").Select

'sayi = WorksheetFunction.CountA(Range("b14")) + 14
sayi = Cells(Rows.Count, "b").End(3).Row

For i = 14 To sayi

If Cells(i, 2).Value > 0 Then

'Cells(i, 35).Value = WorksheetFunction.CountA(Range(("d14:ah14"))) 'GÜN

Cells(i, 35).Value = WorksheetFunction.SumIf((Sheets("KADROLU").Range(Cells(i, 4), Cells(i, 34))), (">0")) 'TOPLAM

End If

Next i

End Sub

halit3 · 24 Mayıs 2020

Merhaba ben yazdığım kodlarla ilgili şu açıklamayı yapmıştım. kod

Kod:

Calendar = vbCalHijri 'Hicri Takvim modu. PC deki Takvimi Hİcriye çevirir.

Kod:

Calendar = vbCalGreg 'Miladi Takvim. PC deki

Calendar nesnesindeki hesaplamalardan dini bayram günlerini otomatik bulmaktadır ancak dini bayram günleri bu nesnenin hesapladığı değil her ülke kendi belirlemektedir onun için dini bayram günleri 1,2 gün önce veya sobra olmaktadır bu düzeltmeyi sizin kendiniz yapmanız gerekiyor.
aşağıdaki linki irdeleyiniz.

TAKVİM resmi ve dini tatil günlerini gösteriyor

1-aylık takvim içinde iş gününü ve tatil günlerini ayırıyor 2-resmi ve dini günleri gösteriyor Haftasonu tatil günlerini seçmeli yaptım sayfa4 deki bölümde açılan mesaj kutusuna hafta gününe gelen sayıyı yazmak yeterli örneğin cumartesi için 6 pazar için 7 cumartesi ve pazar için 67 veya 76...

www.excel.web.tr

behyay · 24 Mayıs 2020

Üstadım Çok teşekkür ediyorum.
O zaman en iyisi makroda hicri takvimi kaldırmak.
Ramazan Bayramınızı tebrik eder, Coranasız nice bayramlar dilerim.
Sağlıcakla kalın.

behyay · 28 Mayıs 2020

Tamamdır. Teşekkür eder, çalışmalarınızda başarılar dilerim.

BLACKICE · 4 Mayıs 2021

Hocam peki If Month(TRH) = 1 And Day(TRH) = 1 Then deg2 = "Yılbaşı" formulunde yılbaşı yazısını tarhin yanındaki hücreye yazdırabilirmiyiz

VBA takvim hatası

behyay

halit3

Uzman

TAKVİM resmi ve dini tatil günlerini gösteriyor

behyay

behyay

BLACKICE