Jak utworzyć miesięczny kalendarz w programie Excel

Tłumaczenia artykułów Tłumaczenia artykułów
Numer ID artykułu: 150774 - Zobacz jakich produktów dotyczą zawarte w tym artykule porady.
Rozwiń wszystko | Zwiń wszystko

Na tej stronie

Streszczenie

W tym artykule podano przykładowe makro w języku Microsoft Visual Basic for Applications (procedura Sub) wyświetlające monit o podanie miesiąca i roku oraz tworzące miesięczny kalendarz przy użyciu arkusza.

Więcej informacji

Firma Microsoft podaje przykłady programowania wyłącznie do celów informacyjnych, bez jakichkolwiek gwarancji wyrażonych wprost lub domyślnie. Dotyczy to także, ale nie ograniczając się do tego zapisu, gwarancji przydatności handlowej lub do określonego celu. W tym artykule zakłada się, że czytelnik zna prezentowany język programowania oraz narzędzia używane do tworzenia i debugowania procedur. Wykwalifikowani pracownicy Pomocy technicznej firmy Microsoft mogą pomóc w wyjaśnieniu, jak działa określona procedura, ale nie będą modyfikować tych przykładów ani dodawać żadnych funkcji i konstruować nowych procedur w celu dostosowania ich do określonych potrzeb użytkownika.

Aby utworzyć kalendarz, wykonaj następujące kroki.

Microsoft Excel 2003

  1. Utwórz nowy skoroszyt.
  2. W menu Narzędzia wskaż polecenie Makro, a następnie kliknij polecenie Edytor Visual Basic.
  3. W menu Insert (Wstaw) kliknij polecenie Module (Moduł).
  4. Skopiuj poniższy kod w języku Visual Basic for Applications do arkusza modułu.
  5. W menu File (Plik) kliknij polecenie „Close and Return to Microsoft Excel” (Zamknij i wróć do programu Microsoft Excel).
  6. Kliknij kartę arkusza Arkusz1.
  7. W menu Narzędzia wskaż polecenie Makro, a następnie kliknij polecenie Makra.
  8. Kliknij pozycję CalendarMaker, a następnie kliknij przycisk Uruchom, aby utworzyć kalendarz.

Microsoft Excel 2007 i Excel 2010

  1. Utwórz nowy skoroszyt.
  2. Na wstążce Deweloper kliknij pozycję Visual Basic.
  3. W menu Wstaw kliknij polecenie Moduł.
  4. Skopiuj poniższy kod w języku Visual Basic for Applications do arkusza modułu.
  5. W menu File (Plik) kliknij polecenie Close and return to Microsoft Excel (Zamknij i wróć do programu Microsoft Excel).
  6. Kliknij kartę arkusza Arkusz1.
  7. Na wstążce Deweloper kliknij pozycję Makra.
  8. Kliknij pozycję CalendarMaker, a następnie kliknij przycisk Uruchom, aby utworzyć kalendarz.

UWAGA: jeśli nie widać Wstążki Deweloper, należy ją włączyć w oknie Opcje programu Excel. W programie Excel 2007 odpowiednia opcja znajduje się w menu Popularne, a w programie Excel 2010 w menu Dostosowywanie Wstążki.

Przykładowa procedura programu Visual Basic

  Sub CalendarMaker()

       ' Wyłączenie ochrony arkusza (jeśli istniał poprzedni kalendarz) w celu zapobieżenia błędowi.
       ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
          Scenarios:=False
       ' Zapobieżenie miganiu ekranu podczas rysowania kalendarza.
       Application.ScreenUpdating = False
       ' Konfiguracja wyłapywania błędów.
       On Error GoTo MyErrorTrap
       ' Wyczyszczenie zakresu a1:g14 wraz z ewentualnym poprzednim kalendarzem.
       Range("a1:g14").Clear
       ' Pobranie odpowiedniego miesiąca i roku za pomocą okna InputBox i ustawienie zmiennej
       ' MyInput.
       MyInput = InputBox("Wpisz miesiąc i rok dla kalendarza ")
       ' Zezwolenie użytkownikowi na zakończenie działania makra przyciskiem Anuluj w oknie InputBox.
       If MyInput = "" Then Exit Sub
       ' Pobranie wartości daty początku wprowadzonego miesiąca.
       StartDay = DateValue(MyInput)
       ' Sprawdzenie, czy data jest prawidłowa, ale nie przypadająca na początku miesiąca
       ' -- jeśli tak, zresetowanie wartości StartDay do pierwszego dnia miesiąca.
       If Day(StartDay) <> 1 Then
           StartDay = DateValue(Year(StartDay) & "/" & Month(StartDay) & "/1")

       End If
       ' Przygotowanie komórki na miesiąc i rok w pełnym zapisie.
       Range("a1").NumberFormat = "mmmm rrrr"
       ' Wyśrodkowanie etykiety miesiąca i roku w zakresie a1:g1 przy odpowiednich
       ' wartościach rozmiaru i wysokości oraz obramowania.
       With Range("a1:g1")
           .HorizontalAlignment = xlCenterAcrossSelection
           .VerticalAlignment = xlCenter
           .Font.Size = 18
           .Font.Bold = True
           .RowHeight = 35
       End With
       ' Przygotowanie zakresu a2:g2 na etykiety dni tygodnia z wyśrodkowaniem i ustawieniem rozmiaru,
       ' wysokości oraz obramowania.
       With Range("a2:g2")
           .ColumnWidth = 11
           .VerticalAlignment = xlCenter
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlCenter
           .Orientation = xlHorizontal
           .Font.Size = 12
           .Font.Bold = True
           .RowHeight = 20
       End With
       ' Umieszczenie dni tygodnia w zakresie a2:g2.
       Range("a2") = "Niedziela"
       Range("b2") = "Poniedziałek"
       Range("c2") = "Wtorek"
       Range("d2") = "Środa"
       Range("e2") = "Czwartek"
       Range("f2") = "Piątek"
       Range("g2") = "Sobota"
       ' Przygotowanie zakresu a3:g7 na daty z wyrównaniem do góry i do lewej oraz ustawieniem rozmiaru, wysokości
       ' i obramowania.
       With Range("a3:g8")
           .HorizontalAlignment = xlRight
           .VerticalAlignment = xlTop
           .Font.Size = 18
           .Font.Bold = True
           .RowHeight = 21
       End With
       ' Umieszczenie podanego miesiąca i roku w pełnym zapisie w komórce a1.
       Range("a1").Value = Application.Text(MyInput, "mmmm rrrr")
       ' Ustawienie zmiennej i pobranie dnia tygodnia, w którym rozpoczyna się miesiąc.
       DayofWeek = WeekDay(StartDay)
       ' Ustawienie zmiennych w celu zidentyfikowania roku i miesiąca jako osobnych
       ' zmiennych.
       CurYear = Year(StartDay)
       CurMonth = Month(StartDay)
       ' Ustawienie zmiennej i obliczenie pierwszego dnia następnego miesiąca.
       FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
       ' Umieszczenie wartości 1 w pozycji komórki pierwszego dnia wybranego
       ' miesiąca na podstawie wartości DayofWeek.
       Select Case DayofWeek
           Case 1
               Range("a3").Value = 1
           Case 2
               Range("b3").Value = 1
           Case 3
               Range("c3").Value = 1
           Case 4
               Range("d3").Value = 1
           Case 5
               Range("e3").Value = 1
           Case 6
               Range("f3").Value = 1
           Case 7
               Range("g3").Value = 1
       End Select
       ' Pętla przez zakres a3:g8 z przyrostem w każdej komórce po komórce
       ' z wartością 1.
       For Each cell In Range("a3:g8")
           RowCell = cell.Row
           ColCell = cell.Column
           ' Wykonanie, jeśli w pierwszej kolumnie jest wartość 1.
           If cell.Column = 1 And cell.Row = 3 Then
           ' Wykonanie, jeśli bieżąca komórka nie znajduje się w pierwszej kolumnie.
           ElseIf cell.Column <> 1 Then
               If cell.Offset(0, -1).Value >= 1 Then
                   cell.Value = cell.Offset(0, -1).Value + 1
                   ' Zatrzymanie, po wprowadzeniu ostatniego dnia
                   ' miesiąca.
                   If cell.Value > (FinalDay - StartDay) Then
                       cell.Value = ""
                       ' Opuszczenie pętli, gdy w kalendarzu wyświetlono właściwą
                       ' liczbę dni.
                       Exit For
                   End If
               End If
           ' Wykonanie tylko, jeśli bieżąca komórka nie znajduje się w trzecim wierszu i znajduje się w pierwszej kolumnie.
           ElseIf cell.Row > 3 And cell.Column = 1 Then
               cell.Value = cell.Offset(-1, 6).Value + 1
               ' Zatrzymanie, po wprowadzeniu ostatniego dnia miesiąca.
               If cell.Value > (FinalDay - StartDay) Then
                   cell.Value = ""
                   ' Opuszczenie pętli, gdy w kalendarzu wyświetlono właściwą liczbę
                   ' dni.
                   Exit For
               End If
           End If
       Next

       ' Utworzenie komórek wprowadzania i sformatowanie ich z wyśrodkowaniem, zawijaniem tekstu i obramowaniem
       ' wokół dni.
       For x = 0 To 5
           Range("A4").Offset(x * 2, 0).EntireRow.Insert
           With Range("A4:G4").Offset(x * 2, 0)
               .RowHeight = 65
               .HorizontalAlignment = xlCenter
               .VerticalAlignment = xlTop
               .WrapText = True
               .Font.Size = 10
               .Font.Bold = False
               ' Odblokowanie tych komórek w celu umożliwienia późniejszego wprowadzania tekstu po
               ' włączeniu ochrony arkusza.
               .Locked = False
           End With
           ' Dodanie obramowania wokół bloku dat.
           With Range("A3").Offset(x * 2, 0).Resize(2, _
           7).Borders(xlLeft)
               .Weight = xlThick
               .ColorIndex = xlAutomatic
           End With

           With Range("A3").Offset(x * 2, 0).Resize(2, _
           7).Borders(xlRight)
               .Weight = xlThick
               .ColorIndex = xlAutomatic
           End With
           Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
              Weight:=xlThick, ColorIndex:=xlAutomatic
       Next
       If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
          .Resize(2, 8).EntireRow.Delete
       ' Wyłączenie linii siatki.
       ActiveWindow.DisplayGridlines = False
       ' Włączenie ochrony arkusza w celu uniemożliwienia zastąpienia dat.
       ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
          Scenarios:=True

       ' Zmiana rozmiaru okna w celu pokazania całego kalendarza (może wymagać dostosowania
       ' pod kątem konfiguracji wideo).
       ActiveWindow.WindowState = xlMaximized
       ActiveWindow.ScrollRow = 1

       ' Zezwolenie na ponowne narysowanie ekranu z wyświetlanym kalendarzem.
       Application.ScreenUpdating = True
       ' Zapobieżenie przejściu do obsługi wyłapywania błędów, chyba że błąd zostanie wychwycony przez istniejącą procedurę
       ' tutaj.
       Exit Sub
   ' Błąd powoduje zasygnalizowanie problemu w oknie msgbox, udostępnienie nowego okna wprowadzania 
   ' i wznowienie w wierszu, który spowodował błąd.
   MyErrorTrap:
       MsgBox "Prawdopodobnie miesiąc lub rok został wprowadzony niepoprawnie." _
           & Chr(13) & "Wpisz miesiąc poprawnie" _
           & " (lub użyj skrótu 3-literowego)" _
           & Chr(13) & "i podaj rok w postaci 4 cyfr"
       MyInput = InputBox("Wpisz miesiąc i rok dla kalendarza")
       If MyInput = "" Then Exit Sub
       Resume
   End Sub
				
Można dodać inny kod, aby dostosować kalendarz do swoich potrzeb. Wstaw dodatkowe wiersze do wprowadzania na ekranie dla każdego dnia lub zmień rozmiar ekranu, aby wyświetlić cały kalendarz zależnie od rozmiaru i rozdzielczości ekranu.

Właściwości

Numer ID artykułu: 150774 - Ostatnia weryfikacja: 31 października 2013 - Weryfikacja: 5.0
Informacje zawarte w tym artykule dotyczą:
  • Microsoft Office Excel 2003
  • Microsoft Office Excel 2007
  • Microsoft Excel 2010
Słowa kluczowe: 
kbautomation kbdtacode kbhowto kbprogramming KB150774

Przekaż opinię

 

Contact us for more help

Contact us for more help
Connect with Answer Desk for expert help.
Get more support from smallbusiness.support.microsoft.com