Soru Şeritte Calendar seçildiğinde, tarihin günleri niye farklı gözüküyor?

[assenucler]

Değerli Dostlar,

Günaydın, ekli resimde de görüleceği gibi; bugün (17 Mart 2022) günü; altta olan (perşembe), solda olan tarihin günü (Cuma) olarak farklı gözükmektedir.

Bunu düzeltmenin bir çözümü var mıdır?

 

[uzmanamele]

Merhaba

Pirelli takvimi kullan

 

[assenucler]

Sayın uzmanamele,

Calender Takvimi hangi siteden indirip kurduğumu hatırlamadığım için yazdım.

 

[ÖmerFaruk]

İlgili kodları da payalaşabilirseniz bir öneri getirebiliriz.

 

[assenucler]

Üstadım,

Geciktiğim için kusura bakmayın. İlk iletiye eklediğim resimdeki Calendar'ın kodlarını nereden görebilirim, bilmiyorum.

 

[Korhan Ayhan]

Sanırım buradan indirip uyguladınız.

https://www.excel.web.tr/threads/excel-ve-worde-takvim.132075/

 

[Merhum İdris SERDAR]

.

Merhaba.

Yabancı bir siteden bulmuştum. Ve dosyayı ben eklemiştim. Ancak böyle bir hatayı görmemiştim. Tarih girişlerini doğru yapıyor.

Kodları da inceldim. Ancak düzeltmeyi başaramadım.

Kodlar:

Option Explicit

Public dtmDate As Date
Public lngMonth As Long
Public lngYearIndex As Long
Public strMonths(0 To 11) As String
Public strMonth As String
Public strYear As String
Public irbRibbonCalendar As IRibbonUI
Public blnInitialized As Boolean
Public lngDateType As Long
Const lngYearWindow As Long = 70

'Callback for customUI.onLoad
Sub CalendarLoad(ribbon As IRibbonUI)
'Stop
    dtmDate = Date 'DateSerial(Val(Date), Month(Date) + 1, 0)
    lngMonth = Month(dtmDate)
    strYear = CStr(Year(dtmDate))
    Set irbRibbonCalendar = ribbon
   
End Sub

'Callback for btnDay01 getLabel
Sub DayLabel(control As IRibbonControl, ByRef returnedVal)
'Stop
    returnedVal = Format(Val(Right(control.ID, 2)), IIf(Len(CStr(Val(Right(control.ID, 2)))) = 1, "  0", "00"))
   
End Sub

'Callback for btnDay01 getVisible
Sub DayVisible(control As IRibbonControl, ByRef returnedVal)
'Stop
    Dim ldtmDate As Date
    ldtmDate = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0)
    Select Case Mid(control.ID, 1, Len(control.ID) - 2)
        Case "btnFalseDay"
            returnedVal = (Val(Right(control.ID, 2)) Mod 14 <= Day(ldtmDate) Mod 14)
        Case "btnDay"
            returnedVal = (Val(Right(control.ID, 2)) Mod 14 <= Day(ldtmDate) Mod 14)
        Case "btnWeedDay"
            returnedVal = (Val(Right(control.ID, 2)) Mod 14 <= Day(ldtmDate) Mod 14)
    End Select
    If Not blnInitialized Then
        blnInitialized = Val(Right(control.ID, 2)) = 31
    End If
   
End Sub

'Callback for btnWeedDay1 getLabel
Sub WeekDayLabel(control As IRibbonControl, ByRef returnedVal)
'Stop
    returnedVal = Left(WeekdayName(Weekday(DateSerial(Year(dtmDate), Month(dtmDate), Val(Right(control.ID, 2))))), 2)
   
End Sub

'Callback for grpActiveMonth getLabel
Sub GroupLabel(control As IRibbonControl, ByRef returnedVal)
'Stop
    returnedVal = FormatDateTime(IIf(dtmDate = 0, Date, dtmDate), vbLongDate)
   
End Sub
'Callback for btnDay getPressed
Sub DayPressed(control As IRibbonControl, ByRef returnedVal)
'Stop
    If blnInitialized Then
        returnedVal = (Val(Right(control.ID, 2)) = Day(dtmDate))
    Else
        returnedVal = (Val(Right(control.ID, 2)) = Day(Date))
    End If

End Sub

'Callback for btnDay01 onAction
Sub DayAction(control As IRibbonControl, pressed As Boolean)
'Stop
    dtmDate = DateSerial(Val(strYear), lngMonth, Val(Right(control.ID, 2)))
    irbRibbonCalendar.Invalidate
    On Error Resume Next
    ActiveCell.Value = FormatDateTime(dtmDate, lngDateType)
    Err.Clear: On Error GoTo -1: On Error GoTo 0

End Sub

'Callback for btnWeedDay getPressed
Sub WeekDayPressed(control As IRibbonControl, ByRef returnedVal)
'Stop
    Dim ldtmDate As Date
    If blnInitialized Then
        ldtmDate = dtmDate
    Else
        ldtmDate = Date
    End If
    If Val(Right(control.ID, 2)) <= 14 Then
        returnedVal = (Val(Right(control.ID, 2)) = IIf(Day(ldtmDate) Mod 14 = 0, 14, Day(ldtmDate) Mod 14)) And Day(ldtmDate) <= 28
    Else
        returnedVal = (Val(Right(control.ID, 2)) Mod 14 = Day(ldtmDate) Mod 14) And Day(ldtmDate) > 28
    End If

End Sub

'Callback for cboMonth onChange
Sub MonthOnChange(control As IRibbonControl, text As String)
'Stop
    strMonth = text
    lngMonth = Application.Match(strMonth, strMonths, 0)
    dtmDate = DateSerial(Val(strYear), lngMonth, Day(Date))
    irbRibbonCalendar.Invalidate
   
End Sub
'Callback for cboDateType onChange
Sub DateTypeOnChange(control As IRibbonControl, text As String)

    If text = "General Date" Then lngDateType = 0
    If text = "Long Date" Then lngDateType = 1
    If text = "Short Date" Then lngDateType = 2

End Sub

'Callback for cboDateType getText
Sub DateTypeGetText(control As IRibbonControl, ByRef returnedVal)
   
    If lngDateType = 0 Then returnedVal = "General Date"
    If lngDateType = 1 Then returnedVal = "Long Date"
    If lngDateType = 2 Then returnedVal = "Short Date"

End Sub


'Callback for cboMonth getItemID
Sub MonthItemID(control As IRibbonControl, index As Integer, ByRef returnedVal)
   
    strMonths(index) = MonthName(index + 1)
   
End Sub

'Callback for cboMonth getItemCount
Sub MonthItemCount(control As IRibbonControl, ByRef returnedVal)

    returnedVal = 12
   
End Sub

'Callback for cboMonth getItemLabel
Sub MonthItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)

    returnedVal = MonthName(index + 1)

End Sub

'Callback for cboMonth getText
Sub MonthGetText(control As IRibbonControl, ByRef returnedVal)

    returnedVal = MonthName(Month(dtmDate), 0)
   
End Sub

'Callback for cboYear onChange
Sub YearOnChange(control As IRibbonControl, text As String)

    strYear = text
    dtmDate = DateSerial(Val(strYear), lngMonth, Day(Date))
    irbRibbonCalendar.Invalidate

End Sub

'Callback for cboYear getItemLabel
Sub YearItemID(control As IRibbonControl, index As Integer, ByRef returnedVal)

    lngYearIndex = index
   
End Sub

'Callback for cboYear getItemCount
Sub YearItemCount(control As IRibbonControl, ByRef returnedVal)

    returnedVal = lngYearWindow
   
End Sub

'Callback for cboYear getItemLabel
Sub YearItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)

    returnedVal = Year(Date) - (lngYearWindow / 2) + index
   
End Sub

'Callback for cboYear getText
Sub YearGetText(control As IRibbonControl, ByRef returnedVal)

    returnedVal = Year(dtmDate)
   
End Sub

'Callback for btnWeedDay01 onAction
Sub WeekDayOnAction(control As IRibbonControl, pressed As Boolean)

    irbRibbonCalendar.InvalidateControl control.ID
   
End Sub

'Callback for btnDay01 getKeytip
Sub DayGetKeyTip(control As IRibbonControl, ByRef returnedVal)
'Stop
    returnedVal = False ' "YY" & Chr(64 + Val(Right(control.ID, 2)))

End Sub

Belki hatayı bulan olur.

.

 

[Zeki Gürsoy]

İdris Bey, gün adını getiren Weekday fonsiyonunun ikinci parametresi haftanın başlangıç gününü seçer. vbMonday olarak düzeltmek işe yarayabilir. Başka bir fark göremedim.



.

 

[uzmanamele]

Merhaba

Söylüyorum size ama dinletemiyorum
Üye olup takvimi indirin

 

[Merhum İdris SERDAR]

İdris Bey, gün adını getiren Weekday fonsiyonunun ikinci parametresi haftanın başlangıç gününü seçer. vbMonday olarak düzeltmek işe yarayabilir. Başka bir fark göremedim.

Ekli dosyayı görüntüle 235065

.

.

'Callback for btnWeedDay1 getLabel
Sub WeekDayLabel(control As IRibbonControl, ByRef returnedVal)
'Stop
    returnedVal = WorksheetFunction.text(DateSerial(Year(dtmDate), Month(dtmDate), Val(Right(control.ID, 2))), "ddd")

End Sub

Burada düzelttim. Ancak gün adlarını İngilizce getiriyor. Bu da kadı kızının kusuru olsun . Bakalım buluncaya kadar.

.
Not:"ddd"yi "ggg" yaparsam, olmuyor.

 

[Merhum İdris SERDAR]

Dosyaları aşağıdaki şekilde düzelttim. Daha anlamlı olması için gün adları tam olarak alındı.

 

[assenucler]

Sayın Korhan Ayhan,

İletinizde değindiğiniz dosyayı indirmiştim. Şu ana değin Türkçe sürüme göre Takvim yazılımında sorun olduğu anlaşılıyor.
Size ve emek veren üstatlarıma emek ve bilgilendirmeleri için teşekkür ediyorum.

Saygılar,
Selim