Monitoring godzin, czyli ile godzin zrealizował nauczyciel danego przedmiotu. E-dziennik co prawda pokazuje tego typu zestawienia, ale niestety nie ma prostego sposobu aby te informacje skorelować z liczbą godzin, które powinien przepracować - to ważne zwłaszcza pod koniec semestru. I tak powstał program MONITORING. Program działa w sieci szkolnej, więc każdy nauczyciel, na swoim służbowym komputerze, może w dowolnej chwili, wypełnić zestawienie.
mgr inż. Wacław Libront
Całość składa się z dwóch (trzech) modułów, ponad 500 wierszy kodu źródłowego:
- wpisywanie i przeglądanie danych dla nauczyciela
- przeglądanie danych i produkowanie zestawień dla dyrektora
- gromadzenie danych
Nauczyciel zlicza za pomocą e-dziennika liczbę odbytych godzin przedmiotu i wpisuje do programu odbyte w miesiącu godziny. Może dopisywać nowe przydziały i poprawiać istniejące. Może wpisywać i poprawiać ilość zrealizowanych godzin. Moduł jest być wielodostępny - kilku nauczycieli może pracować jednocześnie. Dyrektor przegląda wszystkie wpisy nauczycieli i produkuje listę zajęć, dla których zaczyna brakować godzin. Na zapas rozmieszczono w module dodatkowe kolumny na wpisanie godzin niezrealizowanych.
Realizacja
Ręcznie importujemy z PLANU LEKCJI (program zostanie opisany w innej części) przydziały czynności. Tworzymy arkusze dla wszystkich nauczycieli. Moduły wrzucamy na serwer, a skrót do modułu wprowadzania umieszczamy na komputerach nauczycielskich.
Procedury modułu administracyjnego
Sortujemy według nauczycieli (tak będą tworzone arkusze), a dodatkowo według przedmiotów, klas i grup. Nowy arkusz tworzony z przygotowanego wcześniej wzorca. Sprawdzamy istnienie arkusza dla nauczyciela. Tworzenie nowego arkusz przez kopiowanie wzorca.
Nauczyciele wpisali zrealizowane godziny i możemy sprawdzić, komu brakuje godzin. Dyrektor podaje jaki procent godzin jest nieprzekraczalny oraz do którego miesiąca wyszukiwanie. W nowym arkuszu tworzona jest lista.
Dla wszystkich, którzy nie wiedzą, jak wygląda taka aplikacja "od środka"... I jeszcze jedna ciekawostka: napisać to jedno, ale wyeliminować wszelkie błędy i sprawić, żeby to dobrze działało... - to trwa zdecydowanie dłużej niż pisanie poniższych 500 linijek.
Sub TwórzPrzydziały() ActiveWorkbook.Worksheets("PCZ").Sort.SortFields.Clear ActiveWorkbook.Worksheets("PCZ").Sort.SortFields.Add Key:=Range("E2:E500"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets("PCZ").Sort.SortFields.Add Key:=Range("B2:B500"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets("PCZ").Sort.SortFields.Add Key:=Range("C2:C500"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("PCZ").Sort .SetRange Range("A1:F500") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With w = 2 Do nau = Sheets("PCZ").Cells(w, 5) If JestArkusz(nau) = False Then TwórzNowy (nau) Sheets(nau).Select Range("D11").Select w1 = 11 Do god = Sheets("PCZ").Cells(w, 6) prz = Sheets("PCZ").Cells(w, 4) gru = Sheets("PCZ").Cells(w, 3) kla = Sheets("PCZ").Cells(w, 2) Sheets("PCZ").Range("K9") = kla tyg = Sheets("PCZ").Range("L9") Sheets(nau).Cells(w1, 4) = kla Sheets(nau).Cells(w1, 5) = prz Sheets(nau).Cells(w1, 6) = gru Sheets(nau).Cells(w1, 7) = tyg 'ile tygodni Sheets(nau).Cells(w1, 8) = god 'godzin w tygodniu w1 = w1 + 1 w = w + 1 Loop Until Sheets("PCZ").Cells(w, 5) <> nau Loop Until Sheets("PCZ").Cells(w, 1) = "" Sheets("OBSŁUGA").SelectEnd SubFunction JestArkusz(ark As Variant) As Boolean Dim wSheet As Worksheet JestArkusz = False On Error Resume Next Set wSheet = Sheets(ark) If Not wSheet Is Nothing Then JestArkusz = True On Error GoTo 0End FunctionSub TwórzNowy(ark As Variant) Sheets.Add After:=Sheets(Sheets.Count) naz = ActiveSheet.Name Sheets(naz).Select Sheets(naz).Name = ark Sheets("WZOR").Select Cells.Select Selection.Copy Sheets(ark).Select Range("A1").Select ActiveSheet.Paste Range("A2").SelectEnd SubSub SzukajBraków()Dim GG(1 To 12) As ByteGG(1) = 23GG(2) = 25GG(3) = 27GG(4) = 29GG(5) = 31GG(6) = 33GG(7) = 35 'tego nie maGG(8) = 37 'tego nie maGG(9) = 15GG(10) = 17GG(11) = 19GG(12) = 21 Sheets("BRAKI").Select Range("A2:Z10000").Select Selection.ClearContents Range("A2").Select bra = Sheets("OBSŁUGA").Range("A17") mie = Sheets("OBSŁUGA").Range("A18") lb = 1 w = 2 Do nau = Sheets("NAU").Cells(w, 3) Sheets(nau).Select wie = 11 Do tyg = Sheets(nau).Cells(wie, 7) 'ile tygodni nauki g_t = Sheets(nau).Cells(wie, 8) 'ile godzin w tygodniu pla = tyg * g_t If pla > 0 Then m = (GG(mie) - 13) \ 2 mab = Round((pla / 10) * m, 0) jes = 0 For kol = 15 To GG(mie) Step 2 jes = jes + Sheets(nau).Cells(wie, kol) Next kol nie = (mab - jes) / mab If nie > bra Then lb = lb + 1 Sheets("BRAKI").Cells(lb, 1) = lb - 1 Sheets("BRAKI").Cells(lb, 2) = nau Sheets("BRAKI").Cells(lb, 3) = Sheets(nau).Cells(wie, 4) Sheets("BRAKI").Cells(lb, 4) = Sheets(nau).Cells(wie, 5) Sheets("BRAKI").Cells(lb, 5) = Sheets(nau).Cells(wie, 6) Sheets("BRAKI").Cells(lb, 6) = pla Sheets("BRAKI").Cells(lb, 7) = mab Sheets("BRAKI").Cells(lb, 8) = jes Sheets("BRAKI").Cells(lb, 9) = mab - jes End If End If wie = wie + 1 Loop Until Sheets(nau).Cells(wie, 4) = "" w = w + 1 Loop Until Sheets("NAU").Cells(w, 2) = "" Sheets("BRAKI").SelectEnd Sub
Procedury modułu dla nauczyciela
Nauczyciel wybiera z listy swoje dane i wpisuje hasło, aby dane zostały wczytane. Podczas zapisywania sprawdzamy, czy moduł z danymi nie jest zajęty przez innego użytkownika. To główne zadanie, ale prócz tego mnóstwo "drobiazgów", których zadaniem jest zabezpieczyć moduł i dane, czyli jak mawiają informatycy: "żyby program był idiotoodporny".
Public ZAPIS As BooleanSub auto_open() Application.CellDragAndDrop = False 'bez przeciągania komórek CzyśćArkusz Sheets("GODZ").Range("D11").SelectEnd Sub Sub auto_close() Application.CellDragAndDrop = True ThisWorkbook.Saved = TrueEnd SubFunction CzyWstawiać(w, k As Variant) As Boolean CzyWstawiać = True If Cells(w, k) <> "" Then Dim Msg, Style, Title Msg = "KOMÓRKA ZAJĘTA" & Chr(13) & Chr(13) & _ "Czy na pewno zastąpić?" Style = vbYesNo + vbCritical + vbDefaultButton1 Title = "ZAMIANA" wynik = MsgBox(Msg, Style, Title) If wynik = vbNo Then CzyWstawiać = False End If End IfEnd FunctionSub Wstaw(ark, kol As Variant) w = Selection.Row k = Selection.Column If w > 10 Then 'musi być wybrany jakiś wiersz lp = Cells(9, kol) sk = Sheets(ark).Cells(1 + lp, 3) 'wstawiamy skrót k4 = Sheets(ark).Cells(1 + lp, 4) 'czwarta kolumna If CzyWstawiać(w, kol) = True Then Cells(w, kol) = sk If ark = "KLA" Then Cells(w, 7) = k4 'wstawiamy od razu liczbę godzin End If End If Cells(9, kol) = 0End SubSub WstawKlasa() Wstaw "KLA", 4End SubSub WstawPrzedmiot() Wstaw "PRZ", 5End SubSub WstawGrupa() Wstaw "GRU", 6End SubSub WybierzNauczyciela() lp = Range("D8") sk = Sheets("NAU").Cells(1 + lp, 3) 'wstawiamy skrót na = Sheets("NAU").Cells(1 + lp, 2) ' ha = CStr(Sheets("NAU").Cells(1 + lp, 4)) 'hasło If ha <> "" Then Dim Msg, Style, Title Msg = na + " WPISZ HASŁO" Title = "" wynik = InputBox(Msg, Title) If wynik = ha Then WczytajDane Else MsgBox "HASŁO NIEPOPRAWNE" Range("D8") = 0 End If Else MsgBox na + " BRAK HASŁA" + Chr(13) + Chr(13) + _ "wpisz nowe hasło" Msg = na + " NOWE HASŁO" Title = "" wynik = InputBox(Msg, Title) If wynik <> "" Then Sheets("NAU").Cells(1 + lp, 4) = wynik Range("D8") = 0 End If End If End SubSub WczytajDane() On Error GoTo błąd ekranOFF wi = Selection.Row ko = Selection.Column dane = "zestawienie godzin - dane.xls" arkusz = ActiveWorkbook.Name lp = Range("D8") sk = Sheets("NAU").Cells(1 + lp, 3) 'skrót na = Sheets("NAU").Cells(1 + lp, 2) 'nazwa sc = ActiveWorkbook.Path Workbooks.Open sc + "\" + dane If Not (JestArkusz(sk)) Then Workbooks(dane).Close MsgBox "BRAK ARKUSZA" & Chr(13) + Chr(13) + _ CStr(na) & Chr(13) + Chr(13) + "w danych" Range("D8") = 0 ekranON Exit Sub End If Workbooks(dane).Sheets(sk).SelectWklejDoArkusz dane, arkusz 'Workbooks(dane).Save Application.DisplayAlerts = False Workbooks(dane).Close Application.DisplayAlerts = True ekranON Cells(wi, ko).Select Exit Subbłąd: MsgBox "błąd podczas wczytania"End SubSub ZapiszDane() On Error GoTo błąd ekranOFF wi = Selection.Row ko = Selection.Column dane = "zestawienie godzin - dane.xls" arkusz = ActiveWorkbook.Name lp = Range("D8") sk = Sheets("NAU").Cells(1 + lp, 3) 'skrót na = Sheets("NAU").Cells(1 + lp, 2) 'nazwa sc = ActiveWorkbook.Path If CzyOtwartyPlik(sc + "\", dane) Then MsgBox "Właśnie w tej chwili ktoś inny zapisuje swoje dane" + Chr(13) _ + "spróbuj zapisać jeszcze raz za chwilę" + Chr(13) + Chr(13) _ + "Jeśli pojawi się okienko z komunikatem:" + Chr(13) _ + "PLIK AKTUALNIE DOSTĘPNY" + Chr(13) _ + "naciśnij przycisk ANULUJ" ekranON Exit Sub End If '************************************************************** Workbooks.Open sc + "\" + dane If Not (JestArkusz(sk)) Then Workbooks(dane).Close MsgBox "BRAK ARKUSZA" & Chr(13) + Chr(13) + _ CStr(na) & Chr(13) + Chr(13) + "w danych" ekranON Exit Sub End If Workbooks(dane).Sheets(sk).Select Workbooks(arkusz).Activate WklejDoDane dane, arkusz Workbooks(dane).Save Workbooks(dane).Close ekranON Cells(wi, ko).Select Exit Subbłąd: MsgBox "błąd podczas zapisywania" ekranONEnd SubFunction JestArkusz(ark As Variant) As Boolean Dim wSheet As Worksheet JestArkusz = False On Error Resume Next Set wSheet = Sheets(ark) If Not wSheet Is Nothing Then JestArkusz = True On Error GoTo 0End FunctionSub ZapiszZakończ() Dim Msg, Style, Title Msg = "Czy na pewno chcesz" + Chr(13) + Chr(13) + _ "ZAPISAĆ i ZAKOŃCZYĆ?" Title = "ZAPISZ i ZAKOŃCZ" Style = vbYesNo + vbCritical + vbDefaultButton1 wynik = MsgBox(Msg, Style, Title) If wynik = vbYes Then ZapiszDane Application.Quit End IfEnd SubSub Zakończ() Dim Msg, Style, Title Msg = "Czy na pewno chcesz" + Chr(13) + Chr(13) + _ "ZAKOŃCZYĆ" + Chr(13) + Chr(13) + "bez zapisywania?" Title = "ZAKOŃCZ" Style = vbYesNo + vbCritical + vbDefaultButton1 wynik = MsgBox(Msg, Style, Title) If wynik = vbYes Then Application.Quit End IfEnd SubFunction CzyOtwartyPlik(sciezka, nazwa As Variant) As Boolean CzyOtwartyPlik = FalseOn Error GoTo błąd Workbooks.Open Filename:=sciezka & nazwa If Workbooks(nazwa).ReadOnly Then CzyOtwartyPlik = True Workbooks(nazwa).Close SaveChanges:=FalseExit Functionbłąd: MsgBox "bład sprawdzania pliku: " & sciezka & nazwaEnd FunctionPublic Sub ekran(Optional co As Boolean = False) Application.ScreenUpdating = Not Application.ScreenUpdating co = Application.ScreenUpdatingEnd SubPublic Sub ekranON() Application.ScreenUpdating = TrueEnd SubPublic Sub ekranOFF() Application.ScreenUpdating = FalseEnd SubSub ZABOFF() ActiveSheet.UnprotectEnd SubSub ZABON() ActiveSheet.ProtectEnd SubSub WklejDoDane(dane, arkusz As Variant) Range("C10:AH60").Select Selection.Copy Windows(dane).Activate Range("C10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Windows(arkusz).ActivateEnd SubSub WklejDoArkusz(dane, arkusz As Variant) Range("D11:H60").Select Selection.Copy Windows(arkusz).Activate Range("D11").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Windows(dane).Activate Range("O11:AH60").Select Selection.Copy Windows(arkusz).Activate Range("O11").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Windows(dane).ActivateEnd SubSub OdblokujKomórki() Range("D11:H60").Select Selection.Locked = False Selection.FormulaHidden = False Range("O11:AH60").Select Selection.Locked = False Selection.FormulaHidden = FalseEnd SubSub CzyśćArkusz() ekranOFF wi = Selection.Row ko = Selection.Column Range("D8") = 0 Range("D9") = 0 Range("E9") = 0 Range("F9") = 0 ZABOFF OdblokujKomórki Range("D11:H60").Select Selection.ClearContents Range("O11:AH60").Select Selection.ClearContents ZABON ekranON Cells(wi, ko).SelectEnd SubSub SzerokośćKolumn() For k = 1 To 10 k1 = k * 2 + 13 Columns(k1).ColumnWidth = 2.5 Columns(k1 + 1).ColumnWidth = 1.2 Next kEnd SubSub PokażChowajNieodbyte() ZABOFF s = Columns("P").ColumnWidth If s > 0 Then s = 0 Columns("L").ColumnWidth = 0 Else s = 1.2 Columns("L").ColumnWidth = 3.5 End If 'a teraz ustawianie kolumn For k = 1 To 10 k1 = k * 2 + 13 Columns(k1 + 1).ColumnWidth = s Next k ZABONEnd S
Public ZAPIS As Boolean Sub auto_open() Application.CellDragAndDrop = False 'bez przeciągania komórek CzyśćArkusz Sheets("GODZ").Range("D11").Select End Sub Sub auto_close() Application.CellDragAndDrop = True ThisWorkbook.Saved = True End Sub Function CzyWstawiać(w, k As Variant) As Boolean CzyWstawiać = True If Cells(w, k) <> "" Then Dim Msg, Style, Title Msg = "KOMÓRKA ZAJĘTA" & Chr(13) & Chr(13) & _ "Czy na pewno zastąpić?" Style = vbYesNo + vbCritical + vbDefaultButton1 Title = "ZAMIANA" wynik = MsgBox(Msg, Style, Title) If wynik = vbNo Then CzyWstawiać = False End If End If End Function Sub Wstaw(ark, kol As Variant) w = Selection.Row k = Selection.Column If w > 10 Then 'musi być wybrany jakiś wiersz lp = Cells(9, kol) sk = Sheets(ark).Cells(1 + lp, 3) 'wstawiamy skrót k4 = Sheets(ark).Cells(1 + lp, 4) 'czwarta kolumna If CzyWstawiać(w, kol) = True Then Cells(w, kol) = sk If ark = "KLA" Then Cells(w, 7) = k4 'wstawiamy od razu liczbę godzin End If End If Cells(9, kol) = 0 End Sub Sub WstawKlasa() Wstaw "KLA", 4 End Sub Sub WstawPrzedmiot() Wstaw "PRZ", 5 End Sub Sub WstawGrupa() Wstaw "GRU", 6 End Sub Sub WybierzNauczyciela() lp = Range("D8") sk = Sheets("NAU").Cells(1 + lp, 3) 'wstawiamy skrót na = Sheets("NAU").Cells(1 + lp, 2) ' ha = CStr(Sheets("NAU").Cells(1 + lp, 4)) 'hasło If ha <> "" Then Dim Msg, Style, Title Msg = na + " WPISZ HASŁO" Title = "" wynik = InputBox(Msg, Title) If wynik = ha Then WczytajDane Else MsgBox "HASŁO NIEPOPRAWNE" Range("D8") = 0 End If Else MsgBox na + " BRAK HASŁA" + Chr(13) + Chr(13) + _ "wpisz nowe hasło" Msg = na + " NOWE HASŁO" Title = "" wynik = InputBox(Msg, Title) If wynik <> "" Then Sheets("NAU").Cells(1 + lp, 4) = wynik Range("D8") = 0 End If End If End Sub Sub WczytajDane() On Error GoTo błąd ekranOFF wi = Selection.Row ko = Selection.Column dane = "zestawienie godzin - dane.xls" arkusz = ActiveWorkbook.Name lp = Range("D8") sk = Sheets("NAU").Cells(1 + lp, 3) 'skrót na = Sheets("NAU").Cells(1 + lp, 2) 'nazwa sc = ActiveWorkbook.Path Workbooks.Open sc + "\" + dane If Not (JestArkusz(sk)) Then Workbooks(dane).Close MsgBox "BRAK ARKUSZA" & Chr(13) + Chr(13) + _ CStr(na) & Chr(13) + Chr(13) + "w danych" Range("D8") = 0 ekranON Exit Sub End If Workbooks(dane).Sheets(sk).Select WklejDoArkusz dane, arkusz 'Workbooks(dane).Save Application.DisplayAlerts = False Workbooks(dane).Close Application.DisplayAlerts = True ekranON Cells(wi, ko).Select Exit Sub błąd: MsgBox "błąd podczas wczytania" End Sub Sub ZapiszDane() On Error GoTo błąd ekranOFF wi = Selection.Row ko = Selection.Column dane = "zestawienie godzin - dane.xls" arkusz = ActiveWorkbook.Name lp = Range("D8") sk = Sheets("NAU").Cells(1 + lp, 3) 'skrót na = Sheets("NAU").Cells(1 + lp, 2) 'nazwa sc = ActiveWorkbook.Path If CzyOtwartyPlik(sc + "\", dane) Then MsgBox "Właśnie w tej chwili ktoś inny zapisuje swoje dane" + Chr(13) _ + "spróbuj zapisać jeszcze raz za chwilę" + Chr(13) + Chr(13) _ + "Jeśli pojawi się okienko z komunikatem:" + Chr(13) _ + "PLIK AKTUALNIE DOSTĘPNY" + Chr(13) _ + "naciśnij przycisk ANULUJ" ekranON Exit Sub End If '************************************************************** Workbooks.Open sc + "\" + dane If Not (JestArkusz(sk)) Then Workbooks(dane).Close MsgBox "BRAK ARKUSZA" & Chr(13) + Chr(13) + _ CStr(na) & Chr(13) + Chr(13) + "w danych" ekranON Exit Sub End If Workbooks(dane).Sheets(sk).Select Workbooks(arkusz).Activate WklejDoDane dane, arkusz Workbooks(dane).Save Workbooks(dane).Close ekranON Cells(wi, ko).Select Exit Sub błąd: MsgBox "błąd podczas zapisywania" ekranON End Sub Function JestArkusz(ark As Variant) As Boolean Dim wSheet As Worksheet JestArkusz = False On Error Resume Next Set wSheet = Sheets(ark) If Not wSheet Is Nothing Then JestArkusz = True On Error GoTo 0 End Function Sub ZapiszZakończ() Dim Msg, Style, Title Msg = "Czy na pewno chcesz" + Chr(13) + Chr(13) + _ "ZAPISAĆ i ZAKOŃCZYĆ?" Title = "ZAPISZ i ZAKOŃCZ" Style = vbYesNo + vbCritical + vbDefaultButton1 wynik = MsgBox(Msg, Style, Title) If wynik = vbYes Then ZapiszDane Application.Quit End If End Sub Sub Zakończ() Dim Msg, Style, Title Msg = "Czy na pewno chcesz" + Chr(13) + Chr(13) + _ "ZAKOŃCZYĆ" + Chr(13) + Chr(13) + "bez zapisywania?" Title = "ZAKOŃCZ" Style = vbYesNo + vbCritical + vbDefaultButton1 wynik = MsgBox(Msg, Style, Title) If wynik = vbYes Then Application.Quit End If End Sub Function CzyOtwartyPlik(sciezka, nazwa As Variant) As Boolean CzyOtwartyPlik = False On Error GoTo błąd Workbooks.Open Filename:=sciezka & nazwa If Workbooks(nazwa).ReadOnly Then CzyOtwartyPlik = True Workbooks(nazwa).Close SaveChanges:=False Exit Function błąd: MsgBox "bład sprawdzania pliku: " & sciezka & nazwa End Function Public Sub ekran(Optional co As Boolean = False) Application.ScreenUpdating = Not Application.ScreenUpdating co = Application.ScreenUpdating End Sub Public Sub ekranON() Application.ScreenUpdating = True End Sub Public Sub ekranOFF() Application.ScreenUpdating = False End Sub Sub ZABOFF() ActiveSheet.Unprotect End Sub Sub ZABON() ActiveSheet.Protect End Sub Sub WklejDoDane(dane, arkusz As Variant) Range("C10:AH60").Select Selection.Copy Windows(dane).Activate Range("C10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Windows(arkusz).Activate End Sub Sub WklejDoArkusz(dane, arkusz As Variant) Range("D11:H60").Select Selection.Copy Windows(arkusz).Activate Range("D11").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Windows(dane).Activate Range("O11:AH60").Select Selection.Copy Windows(arkusz).Activate Range("O11").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Windows(dane).Activate End Sub Sub OdblokujKomórki() Range("D11:H60").Select Selection.Locked = False Selection.FormulaHidden = False Range("O11:AH60").Select Selection.Locked = False Selection.FormulaHidden = False End Sub Sub CzyśćArkusz() ekranOFF wi = Selection.Row ko = Selection.Column Range("D8") = 0 Range("D9") = 0 Range("E9") = 0 Range("F9") = 0 ZABOFF OdblokujKomórki Range("D11:H60").Select Selection.ClearContents Range("O11:AH60").Select Selection.ClearContents ZABON ekranON Cells(wi, ko).Select End Sub Sub SzerokośćKolumn() For k = 1 To 10 k1 = k * 2 + 13 Columns(k1).ColumnWidth = 2.5 Columns(k1 + 1).ColumnWidth = 1.2 Next k End Sub Sub PokażChowajNieodbyte() ZABOFF s = Columns("P").ColumnWidth If s > 0 Then s = 0 Columns("L").ColumnWidth = 0 Else s = 1.2 Columns("L").ColumnWidth = 3.5 End If 'a teraz ustawianie kolumn For k = 1 To 10 k1 = k * 2 + 13 Columns(k1 + 1).ColumnWidth = s Next k ZABON End Sub
