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
