Создание мини-календаря в vba с помощью пользовательской формы

Я работаю над мини-календарем, который появляется, когда я нажимаю дату в Excel. Мини-календарь выполнен из пользовательской формы. Когда я нажимаю на дату в календаре, он записывает ее в ячейку. Все работает нормально. Однако я хотел бы иметь возможность нажимать на маленькие стрелки в календаре, чтобы менять месяцы и годы.

У меня уже есть этот код, написанный на листе:

И этот код в окне кодирования пользовательской формы:

Я уже пробовал этот код, но тщетно:

Private Sub MonthUp_Click()
’ Diminuer le mois de 1
Dim currentDate As Date
currentDate = DateSerial(UserForm1.Controls(« Année »).Caption, MonthNameToNumber(UserForm1.Controls(« Mois »).Caption), 1)
currentDate = DateAdd(« m », -1, currentDate)
UserForm1.Controls(« Mois »).Caption = VBA.monthName(Month(currentDate), True)
UserForm1.Controls(« Année »).Caption = Year(currentDate)
Feuil4.buildCalendar
End Sub

Private Sub MonthDown_Click()
’ Augmenter le mois de 1
Dim currentDate As Date
currentDate = DateSerial(UserForm1.Controls(« Année »).Caption, MonthNameToNumber(UserForm1.Controls(« Mois »).Caption), 1)
currentDate = DateAdd(« m », 1, currentDate)
UserForm1.Controls(« Mois »).Caption = VBA.monthName(Month(currentDate), True)
UserForm1.Controls(« Année »).Caption = Year(currentDate)
Feuil4.buildCalendar
End Sub

Private Sub YearUp_Click()
’ Diminuer l’année de 1
UserForm1.Controls(« Année »).Caption = UserForm1.Controls(« Année »).Caption - 1
Feuil4.buildCalendar
End Sub

Private Sub YearDown_Click()
’ Augmenter l’année de 1
UserForm1.Controls(« Année »).Caption = UserForm1.Controls(« Année »).Caption + 1
Feuil4.buildCalendar
End Sub

Function MonthNameToNumber(monthName As String) As Integer
’ Convertir le nom du mois en numéro de mois
Dim i As Integer
For i = 1 To 12
If VBA.monthName(i, False) = monthName Then
MonthNameToNumber = i
Exit Function
End If
Next i
End Function

Это не ответ на ваш вопрос, но Month(DateValue("1 " & monthName)) вернет номер месяца, а не будет перебирать каждый номер месяца.

— 18.07.2024 09:25

Для перевода: mois — это месяц по-французски и это пятидневный календарь, начинающийся с понедельника по пятницу. Кроме того, Анне — это год по-французски.

— 18.07.2024 17:20

excel vba userform

16.07.2024 19:35

Преобразование HTML-таблицы в профессиональный документ Excel

Это самый простой способ создания Excel из HTML-таблицы.

Импорт excel в laravel в базу данных

Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...

Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Наконец, он работает с этим кодом в области кодирования пользовательской формы:

Private Sub IblDown_Click()
Dim strd As String
Dim iMonth, iYear, iStartofMonthDay As Integer
Dim startOfMonth, trackingDate As Date
Dim cDay As control

strd = Mois.Caption
Mois.Caption = Format(DateAdd("m", -1, CDate(strd)), "mmmm yyyy")

iYear = Year(DateAdd("m", -1, CDate(strd)))
iMonth = Month(DateAdd("m", -1, CDate(strd)))

startOfMonth = DateSerial(iYear, iMonth, 1)
iStartofMonthDay = Weekday(startOfMonth, vbMonday)

trackingDate = DateAdd("d", -iStartofMonthDay + 1, startOfMonth)
For i = 1 To 30
    ' Skip weekends
    While Weekday(trackingDate) = 7 Or Weekday(trackingDate) = 1 ' If it's Saturday or Sunday
        trackingDate = DateAdd("d", 1, trackingDate) ' Skip to next day
    Wend

    Set cDay = MiniCalendrier.Controls("Jour" & i)
    cDay.Caption = Day(trackingDate)
    cDay.Tag = trackingDate
    
    ' Check if the month of the trackingDate is different from the current month
    If Month(trackingDate) <> iMonth Then
        cDay.ForeColor = 8421504 ' Change the color to gray
    Else
        cDay.ForeColor = 0 ' Change the color to black
    End If

    trackingDate = DateAdd("d", 1, trackingDate)
Next
End Sub

Private Sub IblUp_Click()
Dim strd As String
Dim iMonth, iYear, iStartofMonthDay As Integer
Dim startOfMonth, trackingDate As Date
Dim cDay As control

strd = Mois.Caption
Mois.Caption = Format(DateAdd("m", 1, CDate(strd)), "mmmm yyyy")

iYear = Year(DateAdd("m", 1, CDate(strd)))
iMonth = Month(DateAdd("m", 1, CDate(strd)))

startOfMonth = DateSerial(iYear, iMonth, 1)
iStartofMonthDay = Weekday(startOfMonth, vbMonday)

trackingDate = DateAdd("d", -iStartofMonthDay + 1, startOfMonth)
For i = 1 To 30
    ' Skip weekends
    While Weekday(trackingDate) = 7 Or Weekday(trackingDate) = 1 ' If it's Saturday or Sunday
        trackingDate = DateAdd("d", 1, trackingDate) ' Skip to next day
    Wend

    Set cDay = MiniCalendrier.Controls("Jour" & i)
    cDay.Caption = Day(trackingDate)
    cDay.Tag = trackingDate
    
    ' Check if the month of the trackingDate is different from the current month
    If Month(trackingDate) <> iMonth Then
        cDay.ForeColor = 8421504 ' Change the color to gray
    Else
        cDay.ForeColor = 0 ' Change the color to black
    End If

    trackingDate = DateAdd("d", 1, trackingDate)
Next
End Sub

19.07.2024 17:35

Другие вопросы по теме

Свойство диапазона не возвращает правильное значение для относительного именованного диапазона в VBA Excel 365

Импорт рабочего времени из Excel в MS Project

Макрос для группировки дат из строк

Проверка пустого элемента словаря (не ключа)

Excel/Vba/ADODB: как подключиться к таблице (ListObject) только по ее имени, чтобы выполнить запрос?

Заменить генерирует «Ошибка времени выполнения 13: несоответствие типов», когда диапазон содержит более 1 ячейки

Электронная почта не добавляет скобки [ и ] в формате VBA для Json

Напишите цикл, который будет проверять все вкладки, количество листов, изменение цвета вкладок на основе значений трех ячеек

Вставить как основной текст в документ Word, если это не таблица

Копирование ячеек без определенного текста в макросе Excel

Создание мини-календаря в vba с помощью пользовательской формы

Ответы 1

Другие вопросы по теме

Похожие вопросы