البحث في الموقع

انا محتاج مساعدتكم الكود ده خاص بنموذج تقويم سنة ميلادية ومرفق صورة لشكل النموذج انا جبته وعملت نسخ ليه فى قاعدة البيانات بتاعتى وغيرت من بعض البيانات اللى فى الجدول بتاعى الكود ده بيعطينى خطأ وانا معلم مكان الخطأ باللون الازرق بس مش عارف ليه كل ما يعطينى خطأ يفتح نافذة الكود ويقف على المكان المذكور مرفق نسخة من البرنامج ( تقويم السنة) واريد تطبيقه على البرنامج بتاعى Private Sub PopulateCalendar() On Error GoTo Err_PopulateCalendar Dim strFirstOfMonth As String, bytFirstWeekdayOfMonth As Byte, bytBlockCounter As Byte Dim bytBlockDayOfMonth As Byte, lngBlockDate As Long, ctlDayBlock As Control Dim bytDaysInMonth As Byte, bytEventDayOfMonth As Byte, lngFirstOfMonth As Long Dim lngLastOfMonth As Long, lngFirstOfNextMonth As Long, lngLastOfPreviousMonth As Long Dim lngEventDate As Long, bytBlankBlocksBefore As Byte, bytBlankBlocksAfter As Byte Dim astrCalendarBlocks(1 To 42) As String, dB As Database, rstEvents As Recordset Dim strSelectEvents As String, strEvent As String, strPlatoons As String Dim intMonth As Integer, intYear As Integer, lngSystemDate As Long 'CFB added 1-25-08 Dim ctlSystemDateBlock As Control, blnSystemDateIsShown As Boolean 'CFB added 1-25-08 Dim strSQL As String 'Added 4/16/2008 Dim blnRetVal lngSystemDate = Date 'CFB added 1-25-08 intMonth = objCurrentDate.Month intYear = objCurrentDate.Year lstEvents.Visible = False lblEventsOnDate.Visible = False lblMonth.caption = MonthAndYear(intMonth, intYear) strFirstOfMonth = Str(intMonth) & "/1/" & Str(intYear) 'ADezii 'NOTE: Will work in the UK (United Kingdom) and other European Nations 'strFirstOfMonth = "1/" & Str(intMonth) & Str(intYear) bytFirstWeekdayOfMonth = Weekday(strFirstOfMonth) lngFirstOfMonth = DateSerial(intYear, intMonth, 1) lngFirstOfNextMonth = DateSerial(intYear, intMonth + 1, 1) lngLastOfMonth = lngFirstOfNextMonth - 1 lngLastOfPreviousMonth = lngFirstOfMonth - 1 bytDaysInMonth = lngFirstOfNextMonth - lngFirstOfMonth bytBlankBlocksBefore = bytFirstWeekdayOfMonth - 1 bytBlankBlocksAfter = 42 - (bytBlankBlocksBefore + bytDaysInMonth) Set dB = CurrentDb strSQL = "SELECT * From Production " strSQL = strSQL & "WHERE Production.[Production Date] Between " & lngFirstOfMonth & " And " & lngLastOfMonth & _ " ORDER BY Production.[Production Order];" Set rstEvents = dB.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges) 'Added 4/16/2008 Do While Not rstEvents.EOF strEvent = "[" & rstEvents![Production Order] & "] - " bytEventDayOfMonth = (rstEvents!Production_Date - lngLastOfPreviousMonth) bytBlockCounter = bytEventDayOfMonth + bytBlankBlocksBefore If astrCalendarBlocks(bytBlockCounter) <> "" Then astrCalendarBlocks(bytBlockCounter) = _ astrCalendarBlocks(bytBlockCounter) & vbNewLine & strEvent Else astrCalendarBlocks(bytBlockCounter) = strEvent End If rstEvents.MoveNext Loop For bytBlockCounter = 1 To 42 'blank blocks at start of month Select Case bytBlockCounter Case Is < bytFirstWeekdayOfMonth astrCalendarBlocks(bytBlockCounter) = "" ReferenceABlock ctlDayBlock, bytBlockCounter ctlDayBlock.BackColor = 12632256 ctlDayBlock = "" ctlDayBlock.Enabled = False ctlDayBlock.Tag = "" Case Is > bytBlankBlocksBefore + bytDaysInMonth 'blank blocks at end of month astrCalendarBlocks(bytBlockCounter) = "" ReferenceABlock ctlDayBlock, bytBlockCounter ctlDayBlock.BackColor = 12632256 ctlDayBlock = "" ctlDayBlock.Enabled = False ctlDayBlock.Tag = "" If bytBlankBlocksAfter > 6 And bytBlockCounter > 35 Then ctlDayBlock.Visible = False End If Case Else 'blocks that hold days of the month bytBlockDayOfMonth = bytBlockCounter - bytBlankBlocksBefore ReferenceABlock ctlDayBlock, bytBlockCounter lngBlockDate = lngLastOfPreviousMonth + bytBlockDayOfMonth 'block's date If bytBlockDayOfMonth < 10 Then ctlDayBlock = Space(2) & bytBlockDayOfMonth & _ vbNewLine & astrCalendarBlocks(bytBlockCounter) Else ctlDayBlock = bytBlockDayOfMonth & _ vbNewLine & astrCalendarBlocks(bytBlockCounter) End If 'If this block is the system date, change its color (CFB 1-25-08) If lngBlockDate = lngSystemDate Then ctlDayBlock.BackColor = QBColor(13) ctlDayBlock.ForeColor = QBColor(15) Set ctlSystemDateBlock = ctlDayBlock blnSystemDateIsShown = True Else ctlDayBlock.BackColor = 16777215 ctlDayBlock.ForeColor = 8388608 '====> Added by ADezii on 1/28/2008 (Date End If 'Text was essentially invisible without it for ctlDayBlock.Visible = True 'Block representing current day position) ctlDayBlock.Enabled = True ctlDayBlock.Tag = lngBlockDate End Select Next 'If the system date is in this month, show its events (CFB added 1-25-08) If blnSystemDateIsShown Then PopulateEventsList ctlSystemDateBlock End If Call PopulateYearListBox 'Added by ADezii on 1/28/2008 - suggested by CFB Exit_PopulateCalendar: Exit Sub Err_PopulateCalendar: MsgBox Err.Description, vbExclamation, "Error inPopulateCalendar()" Resume Exit_PopulateCalendar End Sub ConfCtr_Smpl.zip New Microsoft Access Database - Copy.rar