i need to use frmCalendar1 insteed of frmCalendar plz help me. frmcalendar1 contain buttons but frmCalendar contain labels (1 Viewer)

[Hema1]

i need modify this module to open my calendar and chose day from it

 

[June7]

I looked at db. Opening form triggers missing record source error. Calendar button will not click. However, because of language difference I probably can't help anyway.

 

[MajP]

Date Pickers, Calendar Controls, and Calendar resources

There has been some recent interest in a replacement for the MS calendar control that existed prior to 2010. I have been collecting date pickers, calendar controls, and calendars for a long time and thought it would be a good idea to have one thread with lots of good examples. Some of these...

www.access-programmers.co.uk

 

[Hema1]

plz can you modify it for me

 

[Hema1]

I looked at db. Opening form triggers missing record source error. Calendar button will not click. However, because of language difference I probably can't help anyway.

i edit it plz see it again

 

[moke123]

Your trying to run a function on click but the function does not exist.

You also need to add option explicit to your modules and fix the errors

 

[Hema1]

Your trying to run a function on click but the function does not exist.

You also need to add option explicit to your modules and fix th

i need this module if you have

 

[moke123]

plz can you modify it for me

It's not that simple. Date Pickers, Time Pickers, and Calendars take a lot of work to construct. That is why many of us write them once and re-use them in various projects. If you look at the link MajP provided you will see many examples.

To try and modify your form would take quite a bit of time. The date picker I use only requires 3 short lines of code and can be used in any project but won't work with your form.

 

[MajP]

i need this module if you have

I already provided the module, (in fact several). This should be extremely simple, not sure what the problem is. Just simply modify the module to match your control names. What part do you not understand. Should be trivial.
Here it is again.

Option Compare Database
Option Explicit

'This version does not use a custom class. This will be more portable
Private mSelectedDate As Date
'Below Used for multiselect
Private mStartDate As Date
Private mEndDate As Date
Private mMultiSelect As Boolean
Public Event DateChange(ByVal CalendarDate As Date)

Private Sub cmdCancel_Click()
DoCmd.Close acForm, Me.Name
End Sub

'******************************************** Start Events
Private Sub Form_Load()
  Me.SelectedDate = Date
  configureMonthCombo Me.cmboMonth
  LoadYear Me.TextYear
  FillMonthLabels
  DepressSelectedDay
  Me.lblToday.Caption = Format(Date, "DDD, MM/DD/YYYY")
  If IsSubForm Then Me.cmdCancel.Visible = False
  ' MsgBox IsSubForm
End Sub
Private Sub cmdToday_Click()
  SelectToday
  If Not Me.IsSubForm Then DoCmd.Close acForm, Me.Form.Name
End Sub
Private Sub cmboMonth_AfterUpdate()
If IsNumeric(cmboMonth) Then
    ChangeMonth (cmboMonth.Value)
  End If
End Sub
Private Sub TextYear_AfterUpdate()
   If Not IsNumeric(TextYear.Value) Then
     Me.TextYear.Value = Year(Date)
   End If
     ChangeYear (TextYear.Value)
End Sub
Public Function DayClick()
  'MsgBox "dayClick"
  Me.SelectedDate = CDate(ActiveControl.Tag)
  If Month(Me.SelectedDate) <> CInt(Me.cmboMonth.Value) Then
    Me.cmboMonth.Value = (Month(Me.SelectedDate))
    Me.TextYear.Value = (Year(Me.SelectedDate))
    FillMonthLabels
  End If
  DepressSelectedDay
  If Not Me.IsSubForm Then DoCmd.Close acForm, Me.Form.Name
End Function
Private Sub cmdDown_Click()
  Me.TextYear.Value = TextYear.Value - 1
  Me.ChangeYear (Me.TextYear.Value)
End Sub

Private Sub cmdUp_Click()
  Me.TextYear.Value = TextYear.Value + 1
  Me.ChangeYear (Me.TextYear.Value)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'On Error GoTo Err_Handler
    'Purpose:
        Dim previousDate As Date
        Select Case KeyCode
        Case vbKeyLeft              '1 day left or right.
            previousDate = Me.SelectedDate
            RefreshCalendar
            KeyCode = 0
        Case vbKeyRight
            Me.SelectedDate = Me.SelectedDate + 1
            RefreshCalendar
            KeyCode = 0
        Case vbKeyUp                '1 week up or down.
            Me.SelectedDate = Me.SelectedDate - 7
            RefreshCalendar
            KeyCode = 0
        Case vbKeyDown
            Me.SelectedDate = Me.SelectedDate + 7
            RefreshCalendar
            KeyCode = 0
        Case vbKeyHome              'Home/End = first/last of this month.
            Me.SelectedDate = Me.SelectedDate - Day(Me.SelectedDate) + 1
            RefreshCalendar
            KeyCode = 0
        Case vbKeyEnd
             Me.SelectedDate = DateSerial(Year(Me.SelectedDate), Month(Me.SelectedDate) + 1, 0)
             RefreshCalendar
             KeyCode = 0
        Case vbKeyPageUp            'PgUp/PgDn = previous/next month.
            Me.SelectedDate = DateAdd("m", -1, Me.SelectedDate)
            RefreshCalendar
            KeyCode = 0
        Case vbKeyPageDown
            Me.SelectedDate = DateAdd("m", 1, Me.SelectedDate)
            RefreshCalendar
            KeyCode = 0
        End Select
            DepressSelectedDay
Exit_Handler:
    Exit Sub
Err_Handler:
    MsgBox Err.Number & ": " & Err.Description
    Resume Exit_Handler
End Sub
'******************************************** End Events
'******************************************** Start Properties
Public Property Get SelectedDate() As Date
  SelectedDate = mSelectedDate
End Property
Public Property Let SelectedDate(ByVal TheSelectedDate As Date)
    mSelectedDate = TheSelectedDate
    DepressSelectedDay
    RaiseEvent DateChange(TheSelectedDate)
End Property
Public Property Get MultiSelect() As Boolean
  MultiSelect = mMultiSelect
End Property
Public Property Let MultiSelect(ByVal IsMultiSelect As Boolean)
  mMultiSelect = IsMultiSelect
End Property
Public Property Get StartDate() As Date
  StartDate = mStartDate
End Property

Public Property Let StartDate(ByVal TheStartDate As Date)
  mStartDate = TheStartDate
End Property
Public Property Get EndDate() As Date
  EndDate = mEndDate
End Property

Public Property Let EndDate(ByVal TheEndDate As Date)
  mEndDate = TheEndDate
End Property
'****************************************** End Properties
Private Sub RefreshCalendar()
    If Month(Me.SelectedDate) <> CInt(Me.cmboMonth.Value) Then
      Me.cmboMonth.Value = (Month(Me.SelectedDate))
      Me.TextYear.Value = (Year(Me.SelectedDate))
      FillMonthLabels
    End If
End Sub
Private Sub configureMonthCombo(MonthCombo As Access.ComboBox)
  Dim i As Integer
  With MonthCombo
    .RowSourceType = "value list"
    .BoundColumn = 1
    .ColumnCount = 2
    .ColumnWidths = "0;50"
    .LimitToList = True
    .AllowValueListEdits = False
  End With
  For i = 1 To 12
    MonthCombo.AddItem i & ";" & Format(DateSerial(1, i, 1), "Mmmm")
  Next i
  MonthCombo.Value = Month(mSelectedDate)
End Sub
Private Sub LoadYear(TextYear As Access.TextBox)
  TextYear.Value = Year(Me.SelectedDate)
  'MsgBox TextYear.Value
End Sub
Private Sub FillMonthLabels()
'============================================================================================

 

[MajP]

Second part of code since too long to post.

Private Sub FillMonthLabels()
'==================================================================================================
'//Fills the grids label(s) with the correct day and;
'  1) Hides day labels that dont have a date associated with them
'==================================================================================================
    Dim ctl As Access.TextBox
    Dim i As Integer
    Dim FirstDayOfMonth As Date   'First of month
    Dim DaysInMonth As Integer    'Days in month
    Dim intOffSet As Integer      'Offset to first label for month.
    Dim intDay As Integer         'Day under consideration.
    Dim TheYear As Integer        'This was pulled from other code so that is why it is done this way
    Dim TheMonth As Integer       'Instead of simply passing the date
    Const ctlBackColor = 14211288    'Gray color thats used for Holiday shading/unshading
    Const ctlForecolor = 0
    Const TodayForeColor = vbRed
  
    TheYear = Year(Me.SelectedDate)
    TheMonth = Month(Me.SelectedDate)
    FirstDayOfMonth = getFirstOfMonth(TheYear, TheMonth)
    DaysInMonth = getDaysInMonth(FirstDayOfMonth)   'Days in month.
    intOffSet = getOffset(TheYear, TheMonth, vbSunday)    'Offset to first label for month.
    
    For i = 1 To 42
        Set ctl = Me.Controls("txt" & i)
        ctl.Value = ""
        ctl.ForeColor = ctlForecolor
        ctl.BackColor = ctlBackColor  'Resets the backcolor to Gray
        ctl.FontBold = False          'reset bold fonts
        intDay = i - intOffSet        'Transforms label number to day in month
        If intDay > 0 And intDay <= DaysInMonth Then
            ctl.Value = intDay  'Displays day number in correct label
            ctl.Tag = Format(DateSerial(Year(Me.SelectedDate), Month(Me.SelectedDate), intDay), "MM/DD/yyyy")
            'Format todays date
            If DateSerial(TheYear, TheMonth, intDay) = Date Then
              ctl.ForeColor = TodayForeColor
              ctl.FontBold = True
            End If
         Else
            ctl.Value = ""    'Added so months lables that don't display or have a date do not show on grid
        End If
    Next i
    'Code to fill dates from previous month
    FillPreviousMonthLabels
    'Code to fill dates for next month
    FillNextMonthLabels
End Sub
Private Sub FillPreviousMonthLabels()
   ' Could do this lots of ways.  But in this case want to reuse the original code
   Dim i As Integer
   Dim j As Integer
   Dim k As Integer
   Dim ctl As Access.TextBox
   Dim LastDayOfPreviousMonth As Date
   Dim NumberLastDayPreviousMonth As Integer
   Dim TheYear As Integer
   Dim TheMonth As Integer
   TheYear = Year(Me.SelectedDate)
   TheMonth = Month(Me.SelectedDate)
  
   LastDayOfPreviousMonth = getLastDayOfPreviousMonth(TheYear, TheMonth)
   Debug.Print LastDayOfPreviousMonth
   NumberLastDayPreviousMonth = Day(LastDayOfPreviousMonth)
   'Could recalculate the offset saved it as a public variable. But just as easdy to go find the 1 instead
   Do
     i = i + 1
   Loop Until Me.Controls("txt" & i).Value = "1"
   Debug.Print NumberLastDayPreviousMonth
   For j = i - 1 To 1 Step -1
     Set ctl = Me.Controls("txt" & j)
     ctl.Value = NumberLastDayPreviousMonth - k
     ctl.Tag = DateSerial(Year(Me.SelectedDate), Month(Me.SelectedDate) - 1, ctl.Value)
     'some color to set apart
     ctl.ForeColor = RGB(192, 192, 192)
     ctl.BackColor = RGB(255, 255, 255)
     ctl.FontBold = False
     k = k + 1
   Next j
End Sub
Private Sub FillNextMonthLabels()
  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  Dim LastDayOfMonth As Date
  Dim numberLastDayOfMonth As Integer
  Dim ctl As Access.TextBox
  Dim TheYear As Integer
  Dim TheMonth As Integer
 
  TheYear = Year(Me.SelectedDate)
  TheMonth = Month(Me.SelectedDate)
  LastDayOfMonth = getLastDayOfMonth(TheYear, TheMonth)
  numberLastDayOfMonth = Day(LastDayOfMonth)
  i = 43
  Do
   i = i - 1
  Loop Until Me.Controls("txt" & i).Value = CStr(Day(numberLastDayOfMonth))
  k = 1
  For j = i + 2 To 42
     Set ctl = Me.Controls("txt" & j)
     ctl.Value = k
     ctl.Tag = DateSerial(Year(Me.SelectedDate), Month(Me.SelectedDate) + 1, k)
     ctl.ForeColor = RGB(192, 192, 192)
     ctl.BackColor = RGB(255, 255, 255)
     ctl.FontBold = False
     k = k + 1
   Next j
End Sub
Private Function getOffset(intYear As Integer, IntMonth As Integer, Optional DayOfWeekStartDate As Long = vbSunday) As Integer
'==================================================================================================
'If your calendar starts on Sunday and the first day of the month is on a Monday
'Then everything is shifted one day so the second textbox is day one
'If the first day was Saturday then everything shifts 6 days. So label seven shows 1
'==================================================================================================
    Dim FirstOfMonth As Date
    FirstOfMonth = getFirstOfMonth(intYear, IntMonth)
    getOffset = Weekday(FirstOfMonth, DayOfWeekStartDate) - 1
End Function
Public Function getFirstOfMonth(intYear As Integer, IntMonth As Integer) As Date
    getFirstOfMonth = DateSerial(intYear, IntMonth, 1)
End Function
Public Function getDaysInMonth(FirstDayOfMonth As Date) As Integer
    getDaysInMonth = Day(DateAdd("m", 1, FirstDayOfMonth) - 1)   'Days in month.
End Function
Public Function getLastDayOfMonth(TheYear As Integer, TheMonth As Integer) As Date
  If TheMonth = 12 Then
    TheMonth = 1
    TheYear = TheYear + 1
  Else
    TheMonth = TheMonth + 1
  End If
  getLastDayOfMonth = DateSerial(TheYear, TheMonth, 0)
End Function
Public Function getLastDayOfPreviousMonth(TheYear As Integer, TheMonth As Integer) As Date
  getLastDayOfPreviousMonth = DateSerial(TheYear, TheMonth, 0)
End Function
Public Sub ChangeMonth(TheMonth As Integer)
  Me.SelectedDate = DateSerial(Year(Me.SelectedDate), TheMonth, Day(Me.SelectedDate))
  FillMonthLabels
  DepressSelectedDay
End Sub
Public Sub ChangeYear(TheYear As Integer)
  Me.SelectedDate = DateSerial(TheYear, Month(Me.SelectedDate), Day(Me.SelectedDate))
  FillMonthLabels
  DepressSelectedDay
End Sub
Private Sub DepressSelectedDay()
  Dim i As Integer
  Dim ctl As Access.TextBox
  On Error GoTo errlbl
  'MsgBox "depress"
  For i = 1 To 42
     Set ctl = Me.Controls("txt" & i)
     If CDate(ctl.Tag) = (Me.SelectedDate) Then
       ctl.BorderStyle = 8
       ctl.BackColor = RGB(142, 180, 227)
       ctl.SetFocus
       ctl.SelLength = 0
     Else
       If Month(Me.SelectedDate) = CInt(Month(ctl.Tag)) Then
         ctl.BackColor = 14211288
       End If
       ctl.BorderStyle = 1
   End If
   Me.lblSelectedDate.Caption = Format(Me.SelectedDate, "DDD, MM/DD/YYYY")
   Next i
   Exit Sub
errlbl:
   If Err.Number = 2110 Then
     Resume Next
   Else
     MsgBox Err.Number & " " & Err.Description
   End If
End Sub
Public Sub SelectToday()
  Me.SelectedDate = Date
  Me.TextYear.Value = Year(Me.SelectedDate)
  Me.cmboMonth.Value = Month(Me.SelectedDate)
  FillMonthLabels
  DepressSelectedDay
End Sub

Public Function IsSubForm() As Boolean
  'The form should act different if  it is a popup control or subform
  Dim myName As String
  Dim frm As Access.Form
  myName = Me.Name
  IsSubForm = True
  For Each frm In Application.Forms
    If frm Is Me Then
      IsSubForm = False
      Exit For
    End If
  Next frm
End Function