monit1

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

 

 

monit1 monit1

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