Создание календаря

@MeshMe · Регистрация: 11.10.2010

Студворк — интернет-сервис помощи студентам

Ребят, что не правильно в этом коде? не могу понять?

Добавлено через 1 минуту

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub НовыйМесяц()
' Процедура позволяет после выбора пользователем года заполнить параметры календаря
Год = InputBox("Выбрать год создания календаря", "Производственный календарь")
    Range("A1:AC40").Select
    Selection.ClearContents
    Range("N42").Select
Cells(1, 1) = Год
For НомМесяца = 1 To 12
FirstDay = Weekday(DateSerial(CInt(Год), НомМесяца, 1), vbMonday)
k = 1
Cells(1 + ((НомМесяца - 1) \ 3) * 10, 2 + ((НомМесяца - 1) Mod 3) * 10) = ИмяМесяцаПоНомеру(НомМесяца) ' пишем номер месяца
 
For столбец = 1 To 7
    For строка = 2 To 9
        If столбец = 1 Then 'в первом столбце пишем номер недели
         Cells(строка + ((НомМесяца - 1) \ 3) * 10, 1) = Имя_ДняНедели_ПоНомеру(строка - 1)
         If строка = 7 Or строка = 8 Then ' суббота или воскресенье
         Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец).Font.ColorIndex = 3 ' красный цвет
         End If
        ElseIf столбец = 2 Then
        If строка = 9 Then
                 Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10) = WeekNumberISO(DateSerial(CInt(Год), НомМесяца, k - 1))
                 Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Font.ColorIndex = 39 '  цвет
        End If
            If строка <> 9 And строка - 1 >= FirstDay Then ' если не с понедельника
                 Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10) = k
                 If Выходной_Ли_День(DateSerial(CInt(Год), НомМесяца, k)) Or Праздничный_Ли_День(DateSerial(CInt(Год), НомМесяца, k)) Then
                 Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Font.ColorIndex = 3
                 Else
                 Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Interior.ColorIndex = -4142
                 Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Font.ColorIndex = -4105
                  If Пред_Праздничный_Ли_День(DateSerial(CInt(Год), НомМесяца, k)) Then Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Font.ColorIndex = 50
                 End If
                k = k + 1
            Else ' начало нумерации не с понедельника
                  If строка <> 9 Then
                    Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10) = ""
                    If Пред_Праздничный_Ли_День(DateSerial(CInt(Год), НомМесяца, k)) Then Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Font.ColorIndex = 50
                  End If
            End If
        Else
        If строка = 9 Then
                 u = Cells(2 + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10)
                 If u <> "" Then
                    Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10) = WeekNumberISO(DateSerial(CInt(Год), НомМесяца, u))
                    Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Font.ColorIndex = 39 '  цвет
                 End If
        End If
            If строка <> 9 And k <= ДнейВ_Месяце(DateSerial(CInt(Год), НомМесяца, 1)) Then
                 Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10) = k
                 If Выходной_Ли_День(DateSerial(CInt(Год), НомМесяца, k)) Or Праздничный_Ли_День(DateSerial(CInt(Год), НомМесяца, k)) Then
                 Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Font.ColorIndex = 3
                 Else
                 Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Interior.ColorIndex = -4142
                 Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Font.ColorIndex = -4105
                  If Пред_Праздничный_Ли_День(DateSerial(CInt(Год), НомМесяца, k)) Then Cells(строка + ((НомМесяца - 1) \ 3) * 10, столбец + ((НомМесяца - 1) Mod 3) * 10).Font.ColorIndex = 50
                 End If
                 k = k + 1
            End If
        End If
    Next строка
Next столбец
Next НомМесяца
Cells(45, 1) = "Производственный календарь Украины на " & Год & " год"
 
'Cells(1, 31) = АрабскиеЧислаВ_Римские(НомерКвартала(НомерМесяца(Месяцы.Value))) & " квартал"
 
End Sub

Добавлено через 4 минуты
или может дополнительно что то строить надо?

@Alex77755 · 09.11.2010, 15:05

А где ты взял этот код?
Без функций он работать не будет
Имя_ДняНедели_ПоНомеру
WeekNumberISO
Выходной_Ли_День
Праздничный_Ли_День
ДнейВ_Месяце
Таких функций в списке стандартных у меня нет.
Значит все их надо описать. Ну примерно так:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function Имя_ДняНедели_ПоНомеру(N)
Select Case N
Case 1
Имя_ДняНедели_ПоНомеру = "Понедельник"
Case 2
Имя_ДняНедели_ПоНомеру = "Вторник"
Case 3
Имя_ДняНедели_ПоНомеру = "Среда"
Case 4
Имя_ДняНедели_ПоНомеру = "Четверг"
Case 5
Имя_ДняНедели_ПоНомеру = "Пятница"
Case 6
Имя_ДняНедели_ПоНомеру = "Суббота"
Case 7
Имя_ДняНедели_ПоНомеру = "Воскресенье"
Case Else
Имя_ДняНедели_ПоНомеру = ""
End Function

@Sasha_Smirnov · 09.11.2010, 17:06

Visual Basic
1
2
3
Function Имя_ДняНедели_ПоНомеру(N)
Имя_ДняНедели_ПоНомеру = WeekdayName(N)
End Function

Причём это на всех установленных в системе языках!

@Alex77755 · 09.11.2010, 18:18

Я специально показал пример написания функции.
Не говорю уже о том, что функция "Имя_ДняНедели_ПоНомеру" в данном коде не нужна вовсе: достаточно просто вызвать стандартную

@Валерия_34 · 26.02.2011, 14:31

люди мне тоже нужен просто вывод календаря на экран!календарь на год! мы должны ввести только год...не подскажите как?

@gaw · 26.02.2011, 15:48

Сообщение от Валерия_34

люди мне тоже нужен просто вывод календаря на экран!

Элемент управления Календарь 11.0

@Валерия_34 · 26.02.2011, 17:57

нее, надо с помощью макроса написать программку, чтобы календарь выводился!

@Sasha-Smirnov · 26.02.2011, 21:23

У меня в приложенном документе есть код печати календаря на любой месяц любого допустимого года.

А именно вот в этом: Операции с датой

(Кнопка КАЛЕНДАРЬ печатает месяцы по одному, начиная с текущего.)

Сообщение от Валерия_34

люди мне тоже нужен просто вывод календаря на экран

На экран — вот здесь: http://calendarium.ru/s/ (для проверки пригодится).

@mc-black · 27.02.2011, 10:32

Вот вам, студенты-халявщики

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit
 
Sub Test()
    Calendar 2011
End Sub
 
Private Sub Calendar(Year As Long)
    Dim dtDisp As Date, dtStart As Date, dtStop As Date, wsh As Worksheet
    Dim xMonth As Long, yMonth As Long, xDayOfWeek As Long, yWeekNum As Long
    Dim nMonth As Long, sWeekDays(), i As Long
    
    sWeekDays = Array("ПН", "ВТ", "СР", "ЧТ", "ПТ", "СБ", "ВС")
    Set wsh = ThisWorkbook.Worksheets(1)
    With wsh.Range(wsh.Cells(1, 1), wsh.Cells(28, 32))
        .Clear
        .ColumnWidth = 3.86
        .Interior.ColorIndex = 2
    End With
    
    With wsh.Cells(1, 13)
        .Value = "Календарь на " & Year & " год"
        .Font.Size = 14
        .Font.Bold = True
        .Font.ColorIndex = 10
    End With
    
    nMonth = 0
    dtStart = CDate("01.01." & Year)
    dtStop = CDate("31.12." & Year)
    For dtDisp = dtStart To dtStop
        xMonth = ((Month(dtDisp) - 1) Mod 4) * 8
        yMonth = ((Month(dtDisp) - 1) \ 4) * 9
        xDayOfWeek = Weekday(dtDisp, vbMonday) - 1
        yWeekNum = (Day(dtDisp) + Weekday(CDate("01." & Format(dtDisp, "mm.yyyy")), vbMonday) - 2) \ 7
        wsh.Cells(4 + yMonth + yWeekNum, 1 + xMonth + xDayOfWeek).Value = Day(dtDisp)
        If nMonth <> Month(dtDisp) Then
            nMonth = Month(dtDisp)
            wsh.Cells(2 + yMonth, 1 + xMonth).Value = Format(dtDisp, "MMMM")
            With wsh.Range(wsh.Cells(2 + yMonth, 1 + xMonth), wsh.Cells(2 + yMonth, 7 + xMonth))
                .Merge
                .HorizontalAlignment = xlCenter
                .Font.Bold = True
                .Font.ColorIndex = 9
            End With
            With wsh.Range(wsh.Cells(3 + yMonth, 1 + xMonth), wsh.Cells(3 + yMonth, 7 + xMonth))
                .HorizontalAlignment = xlRight
                .Font.ColorIndex = 5
            End With
            For i = 0 To 6
                wsh.Cells(3 + yMonth, 1 + xMonth + i).Value = sWeekDays(i)
            Next i
        End If
    Next
    
    Set wsh = Nothing
End Sub

calendar.rar

@aequit · 18.12.2020, 10:04

Если что, я видел год создания темы...

mc-black, Немного доработал Ваш код, добавив выделение красным цветом выходных и праздничных дней (работает с 2006 по 2036 год). Принцип работы: перед тем, как внести в соответствующую ячейку дату, проверяется, является ли эта дата рабочим днём, и если нет, то шрифт раскрашивается в красный цвет. Рабочие субботы, например, 20.02.2021, остается незакрашенной. После опубликования производственного календаря на следующий 2022 год необходимо добавить соответствующие даты в перечень выходных дней или рабочих суббот на листе 2 (или внести значения соответствующих дат в код функции).
Возможно, кому-нибудь будет полезно.

Новые блоги и статьи Все статьи Все блоги /
Отчёт о затраченных материалах за определенный период с макетом печатной формы Maks 21.04.2026 Отчёт из решения ниже размещён в конфигурации КА2. Задача: разработка отчёта по затраченным материалам за определённый период, с возможностью вывода печатной формы отчёта с шапкой и подвалом. В. . .	Отчёт о спецтехнике находящейся в ремонте Maks 20.04.2026 Отчёт из решения ниже размещен в конфигурации КА2. Задача: отобразить спецтехнику, которая на данный момент находится в ремонте. Есть нетиповой документ "Заявка на ремонт спецтехники" который. . .	Памятка для бота и "визитка" для читателей "Semantic Universe Layer (Слой семантической вселенной)" Hrethgir 19.04.2026 Сгенерировано для краткого описания по случаю сборки и компиляции скелета серверного приложения. И пусть после этого скажут, что статьи сгенерированные AI - туфта и не интересно. И это не реклама -. . .	Запрет удаления строк ТЧ документа при определённом условии Maks 19.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "Аккумуляторы", разработанного в конфигурации КА2. У данного документа есть ТЧ, в которой в зависимости от прав доступа. . .
Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .	Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	09.11.2010, 18:18
	Я специально показал пример написания функции. Не говорю уже о том, что функция "Имя_ДняНедели_ПоНомеру" в данном коде не нужна вовсе: достаточно просто вызвать стандартную 0

@Валерия_34 0 / 0 / 0 Регистрация: 09.09.2010 Сообщений: 41
	26.02.2011, 14:31
	люди мне тоже нужен просто вывод календаря на экран!календарь на год! мы должны ввести только год...не подскажите как? 0

@Валерия_34 0 / 0 / 0 Регистрация: 09.09.2010 Сообщений: 41
	26.02.2011, 17:57
	нее, надо с помощью макроса написать программку, чтобы календарь выводился! 0