Як створити календар на робочому аркуші Excel за допомогою сценарію VBA

Поділитися зараз:

Excel має широкий спектр використання. У цій статті ми покажемо, як створити календар на аркуші за допомогою макросу.

За винятком зберігання та аналізу даних у вашому Excel, ви також можете використовувати його для завершення інших завдань. Наприклад, ви можете збирати інформацію за допомогою Excel, або ви можете записати своє планування на робочому аркуші. Сьогодні ми знайшли нове використання. Ви можете створити календар на аркуші. Ви можете побачити ефект на зображенні нижче.Календар

Ви можете ввести деякі завдання до цього календаря. І функція така ж, як меморандум. Використовуючи Excel, ці завдання будуть зрозумілішими. Тепер виконайте дії, наведені в наступній частині, і подивіться, як це працює.

Створіть календар

  1. Натисніть кнопку “Alt + F11” на клавіатурі, щоб відкрити аркуш.
  2. А потім вставити новий модуль у редактор Visual Basic.
  3. Тепер копіюємо наступні коди в новий модуль:
Sub Create_Monthly_Calender()
    Dim firstweekday As Integer, EndDay As Integer, _
    FirstWeekColumnIndex As Integer, AssignmentDate As Integer, _
    FirstCountNumber As Integer, SecondCountNumber As Integer, _
    LastDay As Range, objRange As Range, RowIndexofLastday As Integer, FirstCountforTargetRange As Integer, SecondCountforTargetRange As Integer

    firstday = InputBox("Input the year, month and the first day with this format: year/month/day")
    If firstday = "" Then Exit Sub


    Range("A1:G1").Merge
    Range("A1") = Year(firstday) & "." & Month(firstday)
    Range("A2") = "Sunday"
    Range("A2").AutoFill Destination:=Range("A2:G2"), Type:=xlFillDefault
    firstweekday = Application.WorksheetFunction.Weekday(firstday)
    Cells(3, firstweekday) = 1

    Select Case Month(firstday)
        Case 1, 3, 5, 7, 8, 10, 12
            EndDay = 31
        Case 4, 6, 9, 11
            EndDay = 30
        Case 2
            If (Year(firstday) Mod 4) = 0 And (Year(firstday) Mod 100) <> 0 Or ((Year(firstday) Mod 400) = 0) Then
                EndDay = 29
            Else
                EndDay = 28
            End If
    End Select

    For FirstWeekColumnIndex = 1 To (7 - firstweekday)
        Cells(3, firstweekday).Offset(0, FirstWeekColumnIndex) = Cells(3, firstweekday).Offset(0, FirstWeekColumnIndex - 1) + 1
    Next FirstWeekColumnIndex

    AssignmentDate = Range("G3") + 1
    For FirstCountNumber = 2 To 10 Step 2
        For SecondCountNumber = 0 To 6
            Cells(3, firstweekday).Offset(FirstCountNumber, 1 - firstweekday + SecondCountNumber) = AssignmentDate
            AssignmentDate = AssignmentDate + 1
            If Cells(3, firstweekday).Offset(FirstCountNumber, 1 - firstweekday + SecondCountNumber) = EndDay Then
                Exit For
            End If
        Next SecondCountNumber
        If Cells(3, firstweekday).Offset(FirstCountNumber, 1 - firstweekday + SecondCountNumber) = EndDay Then
            Exit For
        End If
    Next FirstCountNumber

    ’set format for the range
    With Range("A1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Size = 16
        .Font.Bold = True
        .Interior.Color = RGB(196, 202, 201)
    End With

    With Range("A2:G2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Bold = True
    End With

    For Each LastDay In ActiveSheet.UsedRange
        If LastDay = EndDay Then
            RowIndexofLastday = LastDay.Row
        End If
    Next

    For FirstCountforTargetRange = RowIndexofLastday To 3 Step -2
            With Range("A" & FirstCountforTargetRange, "G" & FirstCountforTargetRange)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .RowHeight = 20
            End With
    Next FirstCountforTargetRange

        For SecondCountforTargetRange = RowIndexofLastday + 1 To 4 Step -2
            With Range("A" & SecondCountforTargetRange, "G" & SecondCountforTargetRange)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Font.Bold = True
                .RowHeight = 50
                .ColumnWidth = 12
            End With
    Next SecondCountforTargetRange

    Set objRange = Range("A1", "G" & (RowIndexofLastday + 1))
    With objRange.Borders
        .Color = vbBlack
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With

    ActiveWindow.DisplayGridlines = False
    Cells(3, firstweekday).Offset(1, 0).Select
End Sub

Отже, це дуже самотній макрос. Але ви можете безпосередньо ним скористатися. І вам не потрібно його змінювати.

  1. Потім натисніть кнопку “F5” на клавіатурі.
  2. У спливаючому вікні введіть дату першого дня у форматі “Рік / Місяць / День”. "День" може бути будь-яким днем ​​цього місяця, тут ми введемо "1".Дата введення
  3. А потім натисніть кнопку «ОК». Далі ви повернетесь до редактора. Для того, щоб перевірити результат, ви можете повернутися до робочого аркуша.

Календар уже з’явився на аркуші. І курсор буде розміщений у порожній комірці першого дня.Результат

З іншого боку, якщо вас не влаштовує формат комірок, ви також можете змінити коди відповідно до своїх уподобань. За допомогою цього календаря ви напевно підвищите ефективність своєї роботи.

Excel не менш схильний до відмов

Якщо ви часто користуєтеся Excel, вам не складе труднощів виявити, що Excel завжди пошкоджується. У більшості випадків вихід з Excel, а потім його перезапуск може вирішити проблему. Однак іноді ви стикаєтеся з серйозним пошкодженням Excel. І в цей момент ви можете скористатися нашим потужним інструментом для... виправити помилку даних XLSX - -Використовуючи цей інструмент, майже всі помилки можна легко вирішити.

Вступ автора:

Анна Ма - експерт із відновлення даних у DataNumen, Inc., яка є світовим лідером у галузі технологій відновлення даних, в тому числі відновити файл Word та перспективні програмні продукти для ремонту. Для отримання додаткової інформації відвідайте WWW.datanumen.com

Поділитися зараз:

Коментарі закриті.