Dim d, iStudent, Student, iLesson, rstA, sSql, sSql1, dCurDate, iCurWeekDay, dDate, c, sCurWeekDay, dEndDate, k, iWidth, sGridColWidth, iCount, rstB, rstH, sSetColor
d = InputFromList ("Выберите группу", "Выбор группы", "Группа", "SELECT GroupDance FROM tblGroups", 1, 300, 500)
If Left(d, 2) = "Ok" Then
d = Mid(d, 4)
End If
SetStatusText Генерирую расписание. Пожалуйста, подождите ...
iWidth = <GridWidth>
iWidth = iWidth - 885 - 400
dDate = Date()
dEndDate = DateAdd("m", 1, dDate)
dDate = InputDate("Выберите дату начала расписания", "Выбор даты начала", dDate)
dEndDate = InputDate("Выберите дату конца расписания", "Выбор даты окончания", dEndDate)
If dDate <> "" AND dEndDate <> ""  Then 
    k = DateDiff("d", dDate, dEndDate)
    iWidth = iWidth / k
    iWidth = INT(iWidth)
    sGridColWidth = "ID=885;"
    For iLesson = 1 To 48
	c = iLesson - 1
	 dCurDate = DateAdd("d", c, dDate)
       iCurWeekDay = Weekday(dCurDate,2)
       ExecuteSQL "UPDATE tblSettings SET SettingValue = 'Поле" & iLesson & "' WHERE SettingName = 'qdfCalendarActivities.Lesson" & ilesson & ".Caption'; "
       ExecuteSQL "UPDATE tblSettings SET SettingValue = 'Поле" & iLesson & "' WHERE SettingName = 'qdfCalendarActivities.Lesson" & ilesson & ".Description'; "
       ExecuteSQL "UPDATE tblCalendarActivities SET Lesson" & iLesson &" = '';"
    Next iLesson
   SetMousePointer vbHourglass
   sSql = "SELECT Count(*) AS iCount FROM qdfCalendarActivities"
    OpenRecordset rstA, sSql
    iCount = rstA("iCount").Value
    rstA.Close()
    sSql = "SELECT Count(*) AS iStudent, Student AS Student FROM tblCompositionGroup WHERE GroupName =  '"& d &"'"
    OpenRecordset rstH, sSql
    sSetColor = ""
    For iStudent = 1 to iCount
        For iLesson = 1 To k
			c = iLesson - 1
            dCurDate = DateAdd("d", c, dDate)
            iCurWeekDay = Weekday(dCurDate,2) 
            If iStudent = 1  Then
                sGridColWidth = sGridColWidth & "Lesson" & iLesson & "=" & iWidth & ";" 
                sCurWeekDay = Choose(iCurWeekDay, "пн", "вт", "ср", "чт", "пт", "сб", "Вс")     
                ExecuteSQL "UPDATE tblSettings SET SettingValue = FORMAT('" & dCurDate &"','dd.MM.YYYY') & ' ' & '" &  sCurWeekDay & "' WHERE SettingName = 'qdfCalendarActivities.Lesson" & ilesson & ".Caption'; "
                ExecuteSQL "UPDATE tblSettings SET SettingValue = FORMAT('" & dCurDate &"','dd.MM.YYYY') & ' ' & '" &  sCurWeekDay & "' WHERE SettingName = 'qdfCalendarActivities.Lesson" & ilesson & ".Description'; "
                ExecuteSQL "UPDATE tblCalendarActivities SET Lesson"& iLesson &" = FORMAT('" & dCurDate &"','dd.MM.YYYY') & ' ' & '" &  sCurWeekDay & "' "
                    If rstH.EOF Then 
                        sSetColor = sSetColor & "Lesson" & iLesson & "=65280 "
                    Else
                        sSetColor = sSetColor & "Lesson" & iLesson & "=10079487 "
                    End If
                
            End If
			
		Next iLesson
    Next iStudent
    rstH.Close()
	ExecuteSQL "UPDATE tblSettings SET SettingValue = '" & sSetColor & "' WHERE SettingName = '1.qdfCalendarActivities.GridColBackColors'"
    SetMousePointer vbDefault
    ExecuteSQL "UPDATE tblSettings SET SettingValue = '" & sGridColWidth & "' WHERE SettingName = '1.qdfCalendarActivities.GridColWidth'"
    MsgBox "Расписание составлено"
    ReOpenTable()
Else 
    MsgBox "Вы не ввели Дату начала или Дату окончания расписания."
End If