Paweł Wiejkut SAP, ABAP, BW & Database Systems :)
W Każdej, choćby najmniejszej firmie bardzo przydatne jest oprogramowanie, które odpowiada za fakturowanie. Tylko czy każda firma musi za takie oprogramowanie zapłacić ? Postaram się udowodnić że w przypadku najmniejszych nie jest to konieczne, na podstawie projektu, który wykonuję na studia.Jeśli chcesz zobaczyć od razu jak działa, zejdź na sam koniec artykułu, jest on tam do pobrania w gotowej, działającej formie. Artykuł ten nie zawiera całej gotowej solucji, a jedynie opisuje kilka wybranych przeze mnie zagadnień.
Założenia
Mój system FV został napisany przy użyciu Virtual Basic Application w Microsoft Excel 2010 PL. Arkusz będzie pomagał we wprowadzaniu danych przy użyciu UserForm’ów, dzięki temu będzie bardziej przyjazny użytkownikowi.Proste kreatory pomogą mu przy wprowadzaniu danych – podobnie jak w zaawansowanych systemach komputerowych. Pokaże wam teraz jak zamienić wstążkę na swoją – tak aby użytkownik miał wrażenie odrębności uruchamianego pliku, oraz nie mógł nanieść niepotrzebnych zmian.
Edycja wstążki
Po pierwsze, modyfikujemy wygląd naszego arkusza tak,aby był zgodny z wcześniej przyjętymi przez nas założeniami. Do tego będziemy potrzebowali programu o nazwie Custom UI Editor:
Pobierz Custom Ui EditorNajpierw tworzymy gdzieś nowy, pusty arkusz excela. Następnie wypakowujemy, instalujemy i uruchamiamy program. Później z górnego menu, wybieramy File -> Open, i wskazujemy wcześniej stworzony plik. Teraz możemy już edytować naszą wstążkę.Na początek proponuję wkleić poniższy kod, za chwilę go omówimy.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
<customUI xmlns='http://schemas.microsoft.com/office/2006/01/customui'> <ribbon startFromScratch="true"> <tabs> <tab id="CustomTab" label="Ksiegowosc"> <group id="Group" label="Faktury"> <button id="button" label="Wystaw FV" size="large" onAction="okno" imageMso="AutoFormatWizard" /> <button id="button2" label="FV na podstawie paragonu" size="large" imageMso="AccessRelinkLists" /> </group> </tab> </tabs> </ribbon> </customUI> |
Co się tutaj dokładnie stało ? Otóż – w pierwszej linijce za pomocą <customUi xmlns=”> wskazaliśmy,że nasza wstążka ma być zgodna z excelem w wersji 2007, dla podniesienia kompatybilności. Natomiast przypisanie wartości true do <ribbon startFromScratch>, spowodowało, że nasz arkusz wystartuje tylko z utworzonymi przez nas elementami wstążki – te podstawowe nie będą widoczne. Znacznik <tabs> służy do otworzenia obsługi zakładek. Następnie każdą należy opisać wewnątrz <tab>. Opisujemy tam poszczególne grupy, które są później oddzielone spedatorami. Wewnątrz tych grup tworzymy wreszcie poszczególne przyciski,które będą miały za zadanie uruchamiać poszczególne funkcje.Warto wspomnieć jeszcze o <imageMso>, który odpowiada za ikonkę przy każdym guziku.Stworzona na podstawie powyższego kodu zakładka może wyglądać np tak:
Programujemy !
Czas zatem zabrać się za drugą – bardziej pracochłonną część. Ogólnie aby nie pogubić się w tym co będę chciał wam wytłumaczyć, proponuję abyście pobrali sobie mój gotowy projekt i śledzili wszystko razem z tym poradnikiem.Otwórzmy go teraz . Jak widzisz, zamiast standardowych zakładek, u mnie występują te, które sam stworzyłem zgodnie z procedurą powyżej. Teraz wystarczy wcisnąć kombinację klawiszy Alt+F11, i już, jesteśmy w edytorze VBA. Wybierzmy więc teraz z menu po lewej stronie userform „DodajEdytujTowar”, klikając na niego prawym i wybierając „View Code”. Powinniście zobaczyć taki kod:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
Private Sub TextBox1_AfterUpdate() Dim sprawdz As Variant On Error Resume Next sprawdz = Sheets("Towary").Cells.Find(What:=TextBox1.Value, After:=Cells(2, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row If IsNumeric(TextBox1.Value) Then TextBox2.Value = Sheets("Towary").Range("A" & sprawdz).Value TextBox1.Value = Sheets("Towary").Range("B" & sprawdz).Value TextBox3.Value = Sheets("Towary").Range("C" & sprawdz).Value TextBox4.Value = Sheets("Towary").Range("D" & sprawdz).Value TextBox5.Value = Sheets("Towary").Range("E" & sprawdz).Value Else MsgBox "Wprowadzony kod musi być cyfrą" End If End Sub Private Sub CommandButton1_Click() Dim ostw As Long Dim sprawdz As Variant On Error Resume Next sprawdz = Sheets("Towary").Cells.Find(What:=TextBox1.Value, After:=Cells(2, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row If sprawdz = "" Then ostw = Sheets("Towary").Range("A65536").End(xlUp).Row + 1 Sheets("Towary").Range("A" & ostw).Value = TextBox2.Value Sheets("Towary").Range("B" & ostw).Value = TextBox1.Value Sheets("Towary").Range("C" & ostw).Value = TextBox3.Value Sheets("Towary").Range("D" & ostw).Value = TextBox4.Value Sheets("Towary").Range("E" & ostw).Value = TextBox5.Value Else Sheets("Towary").Range("A" & sprawdz).Value = TextBox2.Value Sheets("Towary").Range("B" & sprawdz).Value = TextBox1.Value Sheets("Towary").Range("C" & sprawdz).Value = TextBox3.Value Sheets("Towary").Range("D" & sprawdz).Value = TextBox4.Value Sheets("Towary").Range("E" & sprawdz).Value = TextBox5.Value End If End Sub |
Który jest odpowiedzialny za obsługę tego okna:
i korzysta z tego arkusza:
Dobrze, omówmy sobie teraz, co tu się dzieje. Na samej górze, poleceniem Private Sub TextBox1_AfterUpdate() stworzyłem procedurę, która ma za zadanie uruchomić się dopiero w momencie kiedy pole tekstowe ulegnie zmianie. Dzieje się tak dlatego, że moim założeniem było iż osoba używająca programu będzie używać czytnika kodów kreskowych, a TextBox1, to własnie pole gdzie użytkownik wprowadza kod. Następnie w kodzie widać zadeklarowaną zmienną sprawdz, jest ona odpowiedzialna za to, aby przeszukać arkusz i sprawdzić jaki jest numer wiersza komórki w arkuszu o nazwie „Towary” w którym ewentualnie znajduje się szukany przez nas kod kreskowy . Jeśli zostanie on odnaleziony, numer komórki w którym się znajduje zostaje zapisany w zmiennej. Zapis On Error Resume Next, mówi o tym aby w przypadku wystąpienia błędu program działał nadal. Niżej widzimy pętlę, która poleceniem IsNumeric sprawdza czy zawartość pola TextBox1 jest cyfrą i jesli tak – wypełnia pozostałe pola TextBox danymi dotyczącymi towaru, które są zapisane w arkuszu „Towary”.
Następnie, jak widzisz stworzona jest 2 procedura Private Sub CommandButton1_Click(). Jest ona wykonywana dopiero gdy naciśniemy przycisk „Zakończ” w userform’ie. Zaraz poniżej zadeklarowane są 2 zmienne, z czego zmienna sprawdz nie zmienia się, a zmienna ostw odpowiada za wyświetlenie numeru ostatniego zajętego wiersza. Następnie numer ten zostaje powiększony o 1, tak aby uzyskać numer pierwszego wolnego wiersza w kolumnie A. Zmienna ta jest zadeklarowana, gdyż poniżej jest pętla, która z niej korzysta. Polega to na tym, że jeśli program nie znajdzie naszego kodu kreskowego w programie, to doda nam zupełnie nową pozycję z towarem. Natomiast w przeciwnym wypadku edytowane przez nas dane nadpiszą te wcześniejsze.
Zagłębiamy się coraz bardziej w kod UserForm’ów
Właściwie jeżeli chodzi o UserForm2 i UserForm3, to nie ma tutaj raczej za wiele do tłumaczenia, kod jest bardzo podobny do tego, który rozważaliśmy w przypadku wyżej. Dlatego teraz postaram się omówić przypadek UserForm1. Kod wygląda tak:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
Private Sub CommandButton2_Click() Dim IngLastRow As Long Dim zas As Range lngLstRow = Sheets("Faktura VAT").Range("I65536").End(xlUp).Row + 1 Set zas = Range(Range("I19:I" & lngLstRow).Address) Sheets("Faktura VAT").Range("D" & lngLstRow + 2).Value = Application.WorksheetFunction.Sum(zas) Unload Me End Sub Private Sub CommandButton4_Click() MultiPage1.Value = MultiPage1.Value - 1 End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim IngLastRow As Long Dim rct As Variant wartosc = ListBox1.Value lngLstRow = Sheets("Faktura VAT").Range("E65536").End(xlUp).Row + 1 On Error Resume Next rct = Sheets("Faktura VAT").Cells.Find(What:=wartosc, After:=Cells(1, 2), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row If rct = Flase Then Sheets("Faktura VAT").Range("B" & lngLstRow).Offset(1).EntireRow.Insert Sheets("Faktura VAT").Range("B" & lngLstRow).Value = ListBox1.Value Sheets("Faktura VAT").Range("A" & lngLstRow & ":I" & lngLstRow).Borders.LineStyle = xlContinuous Sheets("Faktura VAT").Range("A" & lngLstRow & ":I" & lngLstRow).Font.Bold = False Sheets("Faktura VAT").Range("A" & lngLstRow & ":I" & lngLstRow).HorizontalAlignment = xlLeft Sheets("Faktura VAT").Range("B" & lngLstRow & ":D" & lngLstRow).Merge Sheets("Faktura VAT").Range("H" & lngLstRow).NumberFormat = "0%" Sheets("Faktura VAT").Range("F" & lngLstRow).NumberFormat = "#,##0.00 $" Sheets("Faktura VAT").Range("G" & lngLstRow).NumberFormat = "#,##0.00 $" Sheets("Faktura VAT").Range("I" & lngLstRow).NumberFormat = "#,##0.00 $" UserForm3.Show Else MsgBox "Towar jest już na liście" End If End Sub Private Sub UserForm_Initialize() Dim r, rt, lngLstRow As Long lngLstRow = Sheets("Faktura VAT").Range("E65536").End(xlUp).Row r = Application.WorksheetFunction.CountA(Sheets("Dane firm").Range("A:A")) rt = Application.WorksheetFunction.CountA(Sheets("Towary").Range("A:A")) If lngLstRow >= 19 Then Sheets("Faktura VAT").Range("E19:E" & lngLstRow).EntireRow.Delete Else End If ComboBox1.List = Sheets("Dane firm").Range("A3:A" & r).Value TextBox1.Value = Date TextBox2.Value = Date ListBox1.ColumnCount = 4 ListBox1.RowSource = "Towary!A3:D" & rt MultiPage1.Value = 0 End Sub Private Sub CommandButton1_Click() Dim rngCell As Long rngCell = Sheets("Dane firm").Cells.Find(What:=ComboBox1.Value, After:=Cells(1, 2), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Sheets("Faktura VAT").Range("H8").Value = ComboBox1.Value Sheets("Faktura VAT").Range("C16").Value = TextBox1.Value Sheets("Faktura VAT").Range("G16").Value = TextBox2.Value Sheets("Faktura VAT").Range("H10").Value = Sheets("Dane firm").Range("B" & rngCell).Value Sheets("Faktura VAT").Range("H11").Value = Sheets("Dane firm").Range("C" & rngCell).Value Sheets("Faktura VAT").Range("H12").Value = Sheets("Dane firm").Range("D" & rngCell).Value Sheets("Faktura VAT").Range("H13").Value = Sheets("Dane firm").Range("E" & rngCell).Value MultiPage1.Value = MultiPage1.Value + 1 End Sub |
A odpowiedzialne okna, tak:
Opiszę wam tutaj obsługę Private Sub UserForm_Initialize(),gdyż wydaje mi się ciekawa. Otóż zawarty w niej kod powoduje, że po każdym uruchomieniu kreatora faktury, excel automatycznie kasuje wszystkie wiersze znajdujące się dalej niż 19. Dzięki temu, za każdym uruchomieniem mamy czysty arkusz.
Tworzenie przeźroczystego UserForm’a
Na koniec zostawiłem sobie kod przeźroczystego formularza. W moim projekcie uruchamia się on jak tło, zaraz po uruchomieniu aplikacji za co odpowiada kod:
|
1 2 3 |
Private Sub Workbook_Open() powitanie.Show End Sub |
Umieszczony w obiekcie Excela o nazwie „Ten_skoroszyt”. Natomiast sam kod działania, jest wpisany w formularzu o nazwie „przeźroczysty” i wygląda mniej więcej tak:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 |
#If VBA7 And Win64 Then Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare PtrSafe Function SetWindowPos Lib "user32.dll" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As Long Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare PtrSafe Function BringWindowToTop Lib "user32.dll" (ByVal hWnd As Long) As Long Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long #Else Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function GetActiveWindow Lib "user32.dll" () As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function BringWindowToTop Lib "user32.dll" (ByVal hWnd As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long #End If Const GWL_STYLE = -16 Const WS_CAPTION = &HC00000 Const WS_SYSMENU = &H80000 Private Const GWL_EXSTYLE = (-20) Private Const WS_EX_LAYERED = &H80000 Private Const LWA_ALPHA = &H2 Dim hWnd As Long Private Sub UserForm_Initialize() Dim lngWindow As Long, lFrmHdl As Long lFrmHdl = FindWindow(vbNullString, Me.Caption) lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE) lngWindow = lngWindow And (Not WS_CAPTION) Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow) Call DrawMenuBar(lFrmHdl) Application.OnTime Now + TimeValue("00:00:05"), "KillForm2" End Sub Private Sub UserForm_activate() Dim ufcap As String ufcap = przezroczysty.Caption hWnd = FindWindow("ThunderDFrame", ufcap) ' Adjust UserForm to Excel's window size With Me .Height = Application.Height .Width = Application.Width .Left = Application.Left .Top = Application.Top End With TransparentUserForm Me, 180 'increase to make darker End Sub Private Function TransparentUserForm(frm As UserForm, Level As Byte) As Boolean ' Makes a UserForm transparent, semi-transparent, or invisible ' Level: 0 to 255 SetWindowLong hWnd, GWL_EXSTYLE, WS_EX_LAYERED SetLayeredWindowAttributes hWnd, 0, Level, LWA_ALPHA TranslucentForm = Err.LastDllError = 0 End Function |
Samo jego działanie jest dość mocno skomplikowane, i wykorzystywane są do tego biblioteki systemowe Windows. Formularz poza kodem musi być jeszcze ustawiony w dość specyficzny sposób, tak aby uzyskać pożądany efekt.
Podsumowanie
Samo działanie aplikacji od strony programistycznej może nie być od razu zrozumiałe. Jednak gdy popatrzysz na to przez dłuższą chwilę i przemyślisz – powinieneś zrozumieć o co dokładnie w nim chodzi. Poniżej, załączam pliki źródłowe do pobrania. To by właściwie było na tyle. Do usłyszenia później.
Pliki źródłowe