Szkoła policealna rządzi się swoimi prawami – zajęcia odbywają się w tzw. „blokach”. Program PLANSP próbuje opanować chaos, jaki mógłby wkraść się w zupełnie inne podejście do układania planu lekcji. W związku z tym, że to właśnie ja zajmuję się układaniem planów dla szkoły policealnej, dlatego też program jest prosty, efektywny i nie musi być wyposażony w różnorodne zabezpieczenia – ja wiem, jak go nie zepsuć! Najważniejsza jest informacja o ilości zajęć do odbycia, wolnych miejscach i drukowanie różnorodnych zestawień: dla studentów, nauczycieli, listy obecności, itp.

mgr inż. Wacław Libront

Niewiele programowania i prawie "zero" formuł w arkuszu. Już jakiś czas temu stwierdziłem, że bezpieczniej jest (niekoniecznie wygodniej) jeśli arkusz nie będzie zawierał formuł, ale wszystko obliczone zostanie za pomocą makropoleceń i wyświetlone dla użytkownika w odpowiednich komórkach.

Ciekawostki z kodu:

• pokazywanie i chowanie kolumn (Sub ZerowePrzedmiotyChowaj())
• funkcja wyszukaj.pionowo() tym razem za pomocą funkcji VB (Function NazwaPrzedmiotu(skr As Variant) As Variant)
• bardzo skomplikowane drukowanie różnorodnych planów zajęć (Sub DrukujListęRD(w, k As Variant))Sub DrukujRozkładN(nau, m1, m2 As Variant)

'wykorzystane w planach nauczania
Sub SchowajCzwartki()
    For w = 7 To 136 Step 3
        Rows(w).RowHeight = 0
    Next w
End Sub
Sub PokażCzwartki()
    For w = 7 To 136 Step 3
        Rows(w).RowHeight = 15
    Next w
End Sub
'pokaż wszystkie
Sub ZerowePrzedmiotyPokaż()
    For k = 8 To 70
        Columns(k).ColumnWidth = 2.6
        If (k = 23) Or (k = 39) Or (k = 55) Then Columns(k).ColumnWidth = 4
    Next k
End Sub

'jeśli w wierszy 3 i 4 jest zero
' to nie ma godzin i można całą kjolumnę schować
Sub ZerowePrzedmiotyChowaj()
    For k = 8 To 70
        g = Cells(3, k) + Cells(4, k)
        p = Cells(1, k) & Cells(2, k)
        If g > 0 Or p <> "" Then
          Columns(k).ColumnWidth = 2.6
        Else
          Columns(k).ColumnWidth = 0
        End If
        If (k = 23) Or (k = 39) Or (k = 55) Then Columns(k).ColumnWidth = 4
    Next k
End Sub
'wstawiamy skrót i otrzymujemy pełną nazwę przedmiotu
'arkusz STUD
Function NazwaPrzedmiotu(skr As Variant) As Variant
On Error GoTo błąd
  s = Application.WorksheetFunction.VLookup(skr, _
  Sheets("STUD").Range("B2:C50"), 2, False)
  NazwaPrzedmiotu = s
  Exit Function
błąd:
  NazwaPrzedmiotu = ""
End Function

'drukuje listę z wybranego kursorem roku i dnia
Sub DrukujListę()
  w = ActiveCell.Row
  k = ActiveCell.Column
  DrukujListęRD w, k
  Sheets("razem").Select
End Sub

'drukuje cztery listy dla czterech kiedrunków z wybranego dnia
Sub DrukujListęDzień()
  w = ActiveCell.Row
  k = ActiveCell.Column
  DrukujListęRD w, 7
  DrukujListęRD w, 23
  DrukujListęRD w, 39
  DrukujListęRD w, 55
  Sheets("razem").Select
End Sub

'drukujemy dla jednej daty D i wybranej grupy R
'parametrami są wybrany wiersz i kolumna
Sub DrukujListęRD(w, k As Variant)
  'czyść
  Sheets("OBEC").Select
  Range("D3:J12").Select
  Selection.ClearContents
  Range("C14:J63").Select
  Selection.ClearContents
  Range("C4").Select
  Rows("14:63").RowHeight = 16.5
    
  Sheets("razem").Select

  'w = ActiveCell.Row
  'k = ActiveCell.Column
  '1 od 7 kol i 15 kolumn
  '2 - 23 do
  rok = Int(((k - 7) / 16)) + 1
  kol = (rok - 1) * 16 + 7 'pierwsza kolumna zawiera nazwę grupu i sumę godzin
  dat = Cells(w, 1)
  dty = Cells(w, 2)
  Sheets("OBEC").Range("D3") = Cells(1, kol)
  Sheets("OBEC").Range("D6") = dat
  
  'studenci na listę
  wi = 2
  Do
    student = Sheets("STUD").Cells(wi, kol)
    Sheets("OBEC").Cells(wi + 12, 3) = student
    wi = wi + 1
  Loop Until Sheets("STUD").Cells(wi, kol) = ""
  
  ko = 4 'od której kolumny zapisujemy w OBEC
  wo = 7 'wiersz od którego zapisujemy znalezione przedmioty
  For k1 = kol + 1 To kol + 15
    ile = Cells(w, k1)
    If ile > 0 Then 'zmalazło godziny
      prz = Cells(1, k1) 'skrót przedmiotu
      nau = Cells(2, k1) 'skrót nauczyciela
      Sheets("OBEC").Cells(wo, 4) = prz
      Sheets("OBEC").Cells(wo, 5) = nau
      'a teraz trzeba znaleźć pełną nazwę
      Sheets("OBEC").Cells(wo, 6) = NazwaPrzedmiotu(prz)
      
      wo = wo + 1
      For i = 1 To ile
        Sheets("OBEC").Cells(11, ko) = ko - 3
        Sheets("OBEC").Cells(12, ko) = prz
        ko = ko + 1 'żeby pamiętało do następnego przedmiotu w tym dniu
      Next i
    End If
  Next k1
      'drukowanie
  'sprawdzamy ile ukryć wierszy
  wi = 64
  Do
    Sheets("OBEC").Rows(wi).RowHeight = 0
    wi = wi - 1
  Loop Until Sheets("OBEC").Cells(wi, 3) <> ""
  
  Sheets("OBEC").Select
  zakres = "$B$3:$J$63"
  ActiveSheet.PageSetup.PrintArea = zakres
  CzyPodgląd = Sheets("razem").Range("E5")
  If CzyPodgląd = True Then
    ActiveWindow.SelectedSheets.PrintPreview
  Else
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
  End If
              
              
  Sheets("OBEC").Select
End Sub

'drukowanie rozkładu dla wybranego roku i okresu od do miesiąca
Sub DrukujRozkład()
    w = ActiveCell.Row
    k = ActiveCell.Column
    'na wszelki wypadek
    rok = 1
    nau = "LW"
    m_od = Range("E3")
    m_do = Range("E4")
    
    Sheets("DRUK").Select
    Columns("A:D").Select
    Selection.ClearContents
    Range("B2").Select
    Sheets("razem").Select
    
    rok = Int(((k - 7) / 16)) + 1
    nau = Cells(w, k)
    If w = 1 Then
        DrukujRozkładM rok, m_od, m_do
    End If
    If w = 2 Then
        DrukujRozkładN nau, m_od, m_do
    End If
    
    If (w > 2) Or (rok = 0) Or (nau = "") Then
        MsgBox "zaznacz rok lub nauczyciela aby wydrukować plan"
    End If
End Sub

'r=1 k=7
'r=2 k=23
'r=3 k=39
'r=4 k=55
'drukowanie rozkładu dla nauczyciela
Sub DrukujRozkładN(nau, m1, m2 As Variant)
    w = ActiveCell.Row
    k = ActiveCell.Column
    rok = Int(((k - 7) / 16)) + 1
    
    Sheets("DRUK").Range("A1") = nau
    w1 = 2
    For w = 8 To 366 + 7
        dat = Cells(w, 1)
        mie = Month(dat)
        'god = Cells(w, kol)
        If (mie >= m1) And (mie <= m2) Then 'And (god > 0) Then
        For k = 7 To 70
            g = Cells(w, k)
            n = Cells(2, k)
            If (g > 0) And (n = nau) Then
          
                'dni tygodnia
                txtd = Format(dat, "yyyy-mm-dd") 'data
                txtw = Format(dat, "ddd") 'dzień tyg
                txt0 = txtd & " (" & txtw & ")"
                
                'tutaj sprawdzamy datę
                'ale mogłoby sprawdzić poprzednią datę
                'jesli taka sama to do poprzedniej dokleić
                dataAKT = txt0
                dataPOP = Sheets("DRUK").Cells(w1 - 1, 2)
                If dataPOP = dataAKT Then
                    w1 = w1 - 1
                End If
                Sheets("DRUK").Cells(w1, 2) = txt0
                
                'godziny
                If Weekday(dat) < 7 Then txtg = "15:00" 'czw
                'If Weekday(dat) = 6 Then txtg = "15:00" 'pią
                If Weekday(dat) = 7 Then txtg = "8:00" 'sob
                Sheets("DRUK").Cells(w1, 3) = txtg 'Weekday(dat)
                txt1 = ""
                prz = Cells(1, k)
                If k >= 7 Then r = 7
                If k >= 23 Then r = 23
                If k >= 39 Then r = 39
                If k >= 55 Then r = 55
                
                rok = Cells(1, r)
                txt1 = rok & " [" & g & "] " & prz
                Sheets("DRUK").Cells(w1, 1) = w1 - 1
                
                txtx = Sheets("DRUK").Cells(w1, 4)
                If txtx <> "" Then txtx = txtx & ", "
                Sheets("DRUK").Cells(w1, 4) = txtx & txt1
                
                w1 = w1 + 1
                
            End If
            
        Next k
        End If
    Next w
    Sheets("DRUK").Select
End Sub

'drukowanie rozkłądu dla roku
Sub DrukujRozkładM(r, m1, m2 As Variant)
    kol = 7 + (r - 1) * 16
    rok = Cells(1, kol)
    Sheets("DRUK").Range("A1") = rok
    w1 = 2
    For w = 8 To 366 + 7
        dat = Cells(w, 1)
        mie = Month(dat)
        god = Cells(w, kol)
        If (mie >= m1) And (mie <= m2) And (god > 0) Then
            'dni tygodnia
            txtd = Format(dat, "yyyy-mm-dd") 'data
            txtw = Format(dat, "ddd") 'dzień tyg
            txt0 = txtd & " (" & txtw & ")"
                
            Sheets("DRUK").Cells(w1, 2) = txt0
            
            'godziny
            If Weekday(dat) < 7 Then txtg = "15:00" 'czw
            'If Weekday(dat) = 6 Then txtg = "15:00" 'pią
            If Weekday(dat) = 7 Then txtg = "8:00" 'sob
            Sheets("DRUK").Cells(w1, 3) = txtg 'Weekday(dat)
            
            'przedmioty
            txt1 = ""
            txtp = ", "
            For k = kol + 1 To kol + 15
                g = Cells(w, k)
                If g > 0 Then
                    prz = Cells(1, k)
                    nau = Cells(2, k)
                    If txt1 = "" Then
                        txt1 = prz & " [" & g & "] " & nau
                    Else
                        txt1 = txt1 & ", " & prz & " [" & g & "] " & nau
                    End If
                End If
            Next k
            Sheets("DRUK").Cells(w1, 1) = w1 - 1
            Sheets("DRUK").Cells(w1, 4) = txt1
            w1 = w1 + 1
        End If
    Next w
    Sheets("DRUK").Select
End Sub

Sub skokPLAN()
    Sheets("razem").Select
End Sub

Sub DzieńNie()
  DzieńOnOff 1
End Sub
Sub DzieńPon()
  DzieńOnOff 2
End Sub
Sub DzieńWto()
  DzieńOnOff 3
End Sub
Sub DzieńŚro()
  DzieńOnOff 4
End Sub
Sub DzieńCzw()
  DzieńOnOff 5
End Sub
Sub DzieńPią()
  DzieńOnOff 6
End Sub
Sub DzieńSob()
  DzieńOnOff 7
End Sub

Sub DzieńOnOff(jaki)
For w = 8 To 311
  dt = CInt(Cells(w, 4))
  If dt = jaki Then
  If Rows(w).RowHeight = 0 Then
            Rows(w).RowHeight = 15.75
        Else
            Rows(w).RowHeight = 0
        End If
  End If
  Next w
End Sub

Sub próba()
  'DzieńOnOff 1
  w = ActiveCell.Row
  k = ActiveCell.Column
  x = CInt(Cells(w, k))
  MsgBox x
End Sub

Sub PodkreślenieNiedzieli()
  wi = ActiveCell.Row
  ko = ActiveCell.Column
  For w = 8 To 311
  dt = CInt(Cells(w, 4))
  If dt = 1 Then
    Rows(w).Select
    'Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    'Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    'Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    'Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    'Selection.Borders(xlEdgeRight).LineStyle = xlNone
    'Selection.Borders(xlInsideVertical).LineStyle = xlNone
    'Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    End If
  Next w
    Cells(wi, ko).Select
End Sub

'wystarczy wybrać komórkę i pokazuje do której skok
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    w = Target.Row
    k = Target.Column
    'MsgBox w & " " & k
End Sub

'pokazuje komórkę w której coś zmieniliśmy
Private Sub Worksheet_Change(ByVal Target As Range)
    'Target.Interior.Color = RGB(255, 0, 0)
    w = Target.Row
    k = Target.Column
    'MsgBox w & " " & k
End Sub