q1wed

Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору mistx нашел я файл, вот он, на одном листе вариант с макросом на другой без. Буквы "О" не ставит - это сам переделывай. Вот код: Код: Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Application.Intersect(Target, Range("a1:b1")) Is Nothing Then Dim i As Integer Dim dt As Date For i = 2 To 32 On Error GoTo errorhandler dt = Cells(2, i).Text + "-" + Cells(1, 2).Text + "-" + Cells(1, 1).Text Cells(3, i).Value = dt If Weekday(dt, vbMonday) = 7 Or Weekday(dt, vbMonday) = 6 Then Range(Cells(3, i), Cells(12, i)).Interior.Color = RGB(115, 160, 245) Else Range(Cells(3, i), Cells(12, i)).Interior.Color = RGB(255, 255, 255) End If Select Case Weekday(dt, vbMonday) Case 1 Cells(4, i) = "Пн." Case 2 Cells(4, i) = "Вт." Case 3 Cells(4, i) = "Ср." Case 4 Cells(4, i) = "Чт." Case 5 Cells(4, i) = "Пт." Case 6 Cells(4, i) = "Сб." Case 7 Cells(4, i) = "Вс." End Select Nextvalue: Next End If Application.EnableEvents = True Exit Sub errorhandler: Range(Cells(3, i), Cells(12, i)).Interior.Color = RGB(185, 185, 185) Range(Cells(3, i), Cells(12, i)).ClearContents Resume Nextvalue End Sub | P.S. Забавно, посидел подумал и понял, что все тоже самое можно было и вовсе без макросов сделать при помощи одной формулы и двух условных форматирований, добавил вариант без макросов в файл. | Всего записей: 208 | Зарегистр. 02-03-2007 | Отправлено: 08:23 02-10-2008 | Исправлено: q1wed, 08:32 02-10-2008 |
|