Jak utworzyć miesięczny kalendarz w programie Excel

Zakończono świadczenie pomocy technicznej dla pakietu Office 2003

Firma Microsoft zakończyła świadczenie pomocy technicznej dla pakietu Office 2003 8 kwietnia 2014. Ta zmiana wpłynęła na Twoje aktualizacje oprogramowania i opcje zabezpieczeń. Dowiedz się, co to oznacza dla Ciebie i jak zapewnić sobie kontynuację ochrony.

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.
 XL2003 XL2007 XL2010
Właściwości

Identyfikator artykułu: 150774 — ostatni przegląd: 10/31/2013 15:02:00 — zmiana: 5.0

Microsoft Office Excel 2003, Microsoft Office Excel 2007, Microsoft Excel 2010

  • kbautomation kbdtacode kbhowto kbprogramming KB150774
Opinia