Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

woda3Na przełomie wieków (jak to pięknie brzmi) Urząd Gminy w Bobowej rozpoczął komputerową rejestrację zużycia wody przez mieszkańców. Dzisiaj to norma, że otrzymujemy pięknie wydrukowaną fakturę - w roku 2000, to była rewolucja. Podstawowe zadania programu: maksymalne uproszczenie wprowadzania danych, archiwizowanie, tworzenie kopiii bezpieczeństwa oraz wydruk faktur i zestawień zbiorczych. Program z powodzeniem funkcjonował w bobowskiej administracji kilka kolejnych lat. 1000 wierszy kodu i 40000 znaków.

woda1 woda2 woda4

Fragment programu odpowiedzialny za numerowanie kolejnych faktur

Sub NumerujFakturyObsługa()
    arkusz = ActiveSheet.Name
    DialogSheets("DNumeruj").EditBoxes("PNumerowanie").Text = Worksheets(arkusz).Range("Q2") + 1 'wpisany do pola następny numer faktury
    If DialogSheets("DNumeruj").Show Then NumerujFaktury
End Sub

'numer pierwszej i ostatniej w Q1 i Q2 nadawany ręcznie w tej procedurze
Sub NumerujFaktury()
    arkusz = ActiveSheet.Name
    On Error GoTo błąd
    numer = DialogSheets("DNumeruj").EditBoxes("PNumerowanie").Text - 1 'żeby w pętli skończyło na dobrym numerze
    napis = "Zostaną ustawione nowe numery faktur.Czy na pewno chcesz wpisać do tabeli nowe numery ?"
    wynik = MsgBox(napis, vbYesNo + vbCritical + vbDefaultButton2, "Numerowanie faktur")
    If wynik = vbYes Then
        Range("Q1") = numer + 1
        Range(Cells(12, 17), Cells(IleWierszy + 11, 17)).Select
        Selection.ClearContents
        For w = 12 To IleWierszy + 11
        If Worksheets(arkusz).Cells(w, 14) <> 0 Then 'obecna ilość różna od zera
            numer = numer + 1
            Worksheets(arkusz).Cells(w, 17).Select 'wybrać komórkę - żeby było widać
            Worksheets(arkusz).Cells(w, 17) = numer 'wpisać numer
        End If
        Next w
        Range("Q2") = numer
    End If
błąd:
    Range("Q12").Select
    Calculate
End Sub

CAŁOŚĆ dla zainteresowanych. Pominięto oczywiście wszelkie wrażliwe fragmenty odpowiedzialne m.in. za zabezpieczenia.

Wacław Libront

Zobacz tutaj