Добрый день уважаемые спецы! Очень нужно решить одну, для меня непосильную, задачу. Есть рукописный календарь на 2016г. Нужно чтобы при нажатии на кнопку происходила смена года(происходила смена дат и ячейки напротив дат становились с бордером, все как в образце только уже 2017 год.)
PS Конечно идеально было бы с возможностью еще и выбора календарь какого года вывести, но если это сложно то буду очень благодарен если просто получится текущий год выводить.
Заранее спасибо за потраченное время!!!!!!!
Добрый день уважаемые спецы! Очень нужно решить одну, для меня непосильную, задачу. Есть рукописный календарь на 2016г. Нужно чтобы при нажатии на кнопку происходила смена года(происходила смена дат и ячейки напротив дат становились с бордером, все как в образце только уже 2017 год.)
PS Конечно идеально было бы с возможностью еще и выбора календарь какого года вывести, но если это сложно то буду очень благодарен если просто получится текущий год выводить.
Заранее спасибо за потраченное время!!!!!!!vdekameron
vdekameron, привет попробуйте вот так (меняем год в AD1 и жмем зеленую кнопку) [vba]
Код
Sub ertert() Dim yr&, mnth(), i&, j&, dt As Date Dim rw&, t&, arr, r As Range yr = Sheets("Лист1").Range("AD1").Value arr = Array("C5", "R5", "AG5", "AV5", "C15", "R15", "AG15", "AV15", "C25", "R25", "AG25", "AV25") For i = 1 To 12 ReDim mnth(1 To 6, 1 To 14): rw = 1 For j = 1 To 31 dt = DateSerial(yr, i, j) t = Weekday(dt, vbMonday)
mnth(rw, t * 2 - 1) = j If t = 7 Then rw = rw + 1 Next j Range(arr(i - 1)).Resize(UBound(mnth), UBound(mnth, 2)).Value = mnth Next i With Range("C5:BI30") .Borders.LineStyle = xlNone For Each r In .Cells If IsNumeric(r.Value) And r.Value > 0 Then r(1, 2).Borders.LineStyle = 1 Next r End With End Sub
[/vba]
vdekameron, привет попробуйте вот так (меняем год в AD1 и жмем зеленую кнопку) [vba]
Код
Sub ertert() Dim yr&, mnth(), i&, j&, dt As Date Dim rw&, t&, arr, r As Range yr = Sheets("Лист1").Range("AD1").Value arr = Array("C5", "R5", "AG5", "AV5", "C15", "R15", "AG15", "AV15", "C25", "R25", "AG25", "AV25") For i = 1 To 12 ReDim mnth(1 To 6, 1 To 14): rw = 1 For j = 1 To 31 dt = DateSerial(yr, i, j) t = Weekday(dt, vbMonday)
mnth(rw, t * 2 - 1) = j If t = 7 Then rw = rw + 1 Next j Range(arr(i - 1)).Resize(UBound(mnth), UBound(mnth, 2)).Value = mnth Next i With Range("C5:BI30") .Borders.LineStyle = xlNone For Each r In .Cells If IsNumeric(r.Value) And r.Value > 0 Then r(1, 2).Borders.LineStyle = 1 Next r End With End Sub
nilem, Добрый день! Огромнейшее Вам спасибо!!!!!!! Бегло проверил вроде все отлично, только нашел один косяк.....у всех месяцев 31 день))) Буду признателен если поправите код.
nilem, Добрый день! Огромнейшее Вам спасибо!!!!!!! Бегло проверил вроде все отлично, только нашел один косяк.....у всех месяцев 31 день))) Буду признателен если поправите код.vdekameron
Ну а что, пусть у всех будет 31 день. Нормально одну строчку добавим
[vba]
Код
Sub ertert() Dim yr&, mnth(), i&, j&, dt As Date Dim rw&, t&, arr, r As Range yr = Sheets("Лист1").Range("AD1").Value arr = Array("C5", "R5", "AG5", "AV5", "C15", "R15", "AG15", "AV15", "C25", "R25", "AG25", "AV25") For i = 1 To 12 ReDim mnth(1 To 6, 1 To 14): rw = 1 For j = 1 To 31 dt = DateSerial(yr, i, j) If Month(dt) <> i Then Exit For 'added row t = Weekday(dt, vbMonday) mnth(rw, t * 2 - 1) = j If t = 7 Then rw = rw + 1 Next j Range(arr(i - 1)).Resize(UBound(mnth), UBound(mnth, 2)).Value = mnth Next i With Range("C5:BI30") .Borders.LineStyle = xlNone For Each r In .Cells If IsNumeric(r.Value) And r.Value > 0 Then r(1, 2).Borders.LineStyle = 1 Next r End With End Sub
[/vba]
Ну а что, пусть у всех будет 31 день. Нормально одну строчку добавим
[vba]
Код
Sub ertert() Dim yr&, mnth(), i&, j&, dt As Date Dim rw&, t&, arr, r As Range yr = Sheets("Лист1").Range("AD1").Value arr = Array("C5", "R5", "AG5", "AV5", "C15", "R15", "AG15", "AV15", "C25", "R25", "AG25", "AV25") For i = 1 To 12 ReDim mnth(1 To 6, 1 To 14): rw = 1 For j = 1 To 31 dt = DateSerial(yr, i, j) If Month(dt) <> i Then Exit For 'added row t = Weekday(dt, vbMonday) mnth(rw, t * 2 - 1) = j If t = 7 Then rw = rw + 1 Next j Range(arr(i - 1)).Resize(UBound(mnth), UBound(mnth, 2)).Value = mnth Next i With Range("C5:BI30") .Borders.LineStyle = xlNone For Each r In .Cells If IsNumeric(r.Value) And r.Value > 0 Then r(1, 2).Borders.LineStyle = 1 Next r End With End Sub
nilem, Я был бы не против) Тогда времени было бы больше)) Спасибо вам большое! И огромный респект. Всегда уважал программистов! У меня допустим голова так не варит...))
nilem, Я был бы не против) Тогда времени было бы больше)) Спасибо вам большое! И огромный респект. Всегда уважал программистов! У меня допустим голова так не варит...))vdekameron
Год можно менять спин-кнопкой на любой странице. Все формулы на странице "настройка и расчет", если интересно... "Бордюристые" ячейки сделаны условным форматированием: Есть число слева? Рисуем рамку! Вертикальный календарь сделан без них, но кто нам мешает вставить столбцы и скопировать форматирование?
Защита на страницах "декоративная", без пароля, чтоб случайно что-нибудь не удалить.
Форматируем календарь под себя и печатаем, спин-кнопка на печать не выводится.
Календарь без программирования.
Год можно менять спин-кнопкой на любой странице. Все формулы на странице "настройка и расчет", если интересно... "Бордюристые" ячейки сделаны условным форматированием: Есть число слева? Рисуем рамку! Вертикальный календарь сделан без них, но кто нам мешает вставить столбцы и скопировать форматирование?
Защита на страницах "декоративная", без пароля, чтоб случайно что-нибудь не удалить.
Форматируем календарь под себя и печатаем, спин-кнопка на печать не выводится.Tezcatlipoca
Запостил именно сюда, как ответ на вопрос vdekameron. Что он просил? "Нужно чтобы при нажатии на кнопку происходила смена года(происходила смена дат и ячейки напротив дат становились с бордером, все как в образце только уже 2017 год.)" Я так и сделал. Хотите, сделаю то же самое, только на VBA, только какой смысл? Чтоб купить хлеб, не всегда ведь нужен транспорт.
Если сильно мешает, можете удалить. Переносить в "готовые решения"? даже не знаю... не думаю, что сделал что-то выдающееся Я, конечно, спрошу vdekameron-а в личке, нужен ли ему мой вариант, может ему именно VBA требовался...
Запостил именно сюда, как ответ на вопрос vdekameron. Что он просил? "Нужно чтобы при нажатии на кнопку происходила смена года(происходила смена дат и ячейки напротив дат становились с бордером, все как в образце только уже 2017 год.)" Я так и сделал. Хотите, сделаю то же самое, только на VBA, только какой смысл? Чтоб купить хлеб, не всегда ведь нужен транспорт.
Если сильно мешает, можете удалить. Переносить в "готовые решения"? даже не знаю... не думаю, что сделал что-то выдающееся Я, конечно, спрошу vdekameron-а в личке, нужен ли ему мой вариант, может ему именно VBA требовался...Tezcatlipoca