Opracował W. Gierulski
Visual Basic dla Aplikacji w Excelu
Ćwiczenie 7; formularze - ankieta
Zbudować aplikację umożliwiającą wprowadzanie danych ankietowych do arkusza Excel, oraz analizę
wprowadzonych danych.
1. W skoroszycie pozostaw cztery arkusze o nazwach ankieta, baza, tło, tytuł.
2. W arkuszu ankieta w wierszu 2 wpisz w kolejnych komórkach:
liczba A2 płeć D2 zadowolenie G2 ile_lat J2
lp B2 wykształcenie E2 prywatne H2 kupno K2
wiek C2 marka F2 zarobkowe I2 uwagi L2
Zaznacz blok A2:L3, a następnie wybierz z menu wstaw - nazwy- utwórz-górny wiersz. W ten sposób zostaną
nadane nazwy dla komórek z trzeciego wiersza.
3. Przejdz
do edytora VB, wstaw formularz(Insert|UserForm). Nadaj mu nazwę oraz tytuł (właściwość Name,
Caption) ANKIETA. Następnie umieść w nim obiekty z paska Formularze.
1
2
7
5
9
10
6 3 8 4
" 1-2- lista+pole edycji, nadaj nazwy (właściwość Name) pole_1 (dla 1), lista_1 (dla 2).
" 3-pole edycji, nadaj nazwę pole_2
" 4-pole listy, nadaj nazwę lista_2
" 5-pole edycji, nadaj nazwę pole_3
" 6-pasek przewijania, nadaj nazwę pasek_1, ustal wartość maksymalną 100
" 7-etykieta, nadaj nazwę etykieta_2
" 8-etykieta, nadaj nazwę etykieta_1
" 9-cztery kolejne obiekty pole wyboru, nadaj nazwy wybór_1, wybór_2, wybór_3, wybór_4, umieść pola w
odpowiednich ramkach; dla ramek określ właściwość Caption - odpowiednio użytkowanie, samochód
" 10-dwa obiekty przycisk opcji, nadaj nazwy opcja_1, opcja_2, umieść pola w ramce z ustawioną
właściwością Caption
" pozostałe obiekty formularza, tak jak na rysunku; dla przycisków określ właściwości Name oraz Caption.
4. W arkuszu baza w komórkach A2:A11 wpisz nazwy samochodów. We właściwości
Row Source listy lista_1 wpisz adres zakresu baza!A2:A11 z nazwami samochodów.
5. W arkuszu baza w komórkach D2:D5 wpisz rodzaj wykształcenia. We właściwości
Row Source listy lista_2 wpisz adres zakresu baza! D2: D5
PROCEDURY DLA FORMULARZA
6. Dwukrotnym kliknięciem listy lista_l wejdz
do edycji procedury - zdarzenia (uruchamianej automatycznie w
momencie kliknięcia listy) i wpisz jej treść. Zadaniem procedury jest wpisanie do pola tekstowego pole_1
elementu wybranego z listy.
Informatyka  programowanie, Politechnika Świętokrzyska str. 1
Private Sub lista_1_Click()
'pole_1.Text = lista_1.List(lista_1.ListIndex)
pole_1.Text = lista_1.Value
End Sub
7. Przejdz
do formularza, kliknij dwukrotnie pasek pasek_l i wpisz procedurę  zdarzenie. Zadaniem procedury jest
przekazanie do etykiety wartości wyselekcjonowanej na pasku.
Private Sub pasek_1_Change()
etykieta_1.Caption = pasek_1.Value
End Sub
8. Dwukrotnie klikając przycisk z napisem koniec przejdz
do edycji procedury - zdarzenia Procedura ta będzie
uruchamiana przy kliknięciu przycisku.
Private Sub koniec_Click()
ANKIETA.Hide
Worksheets("tytuł").Select
Range("a1").Select
End Sub
9. Nad oknem kodu wybierz w liście po lewej General (Ogólne) i wpisz deklaracje:
Option Explicit
Dim liczba_wpisów As Integer
10. Wpisz procedury lokalne. Zadaniem tej procedury jest wyczyszczenie elementów formularza przed następnym
wczytywaniem.
Sub czyszczenie()
pole_3.Text =""
Lista_1.ListIndex = 0
Lista_2.ListIndex = 1
pole_1.Text = ""
pole_2.Text = ""
etykieta_1. Caption = 0
pasek_1.Value = 0
wybór_1.Value = False
wybór_2.Value = False
wybór_3.Value = False
wybór_4.Value = False
Opcja_1.Value = False
Opcja_2.Value = True
etykieta_2.Caption = liczba_wpisów + 1
End Sub
11. Kolejna procedura służy do modyfikowania zmiennej liczba_wpisów, pamiętającej, ile rekordów jest zapisanych w
ankiecie. Informacja ta przechowywana jest w komórce liczba arkusza.
Sub licznik()
liczba_wpisów = Range("liczba") + 1
Range("liczba").Value = liczba_wpisów
End Sub
12. Przejdz
do formularza, kliknij dwukrotnie przycisk następny wpis i wpisz procedurę - zdarzenie. Procedura ta
będzie uruchamiana przez kliknięcie przycisku. Jej zadaniem jest przekazanie informacji z okien edycyjnych do
arkusza ankieta.
Private Sub następny_wpis_Click()
Dim płeć As String, prywatne As String
Dim zarobkowe As String, ile_lat As String, kupno As String
licznik
If Opcja_1.Value Then
płeć = "kobieta"
End If
If Opcja_2.Value Then
płeć = "mężczyzna"
End If
If wybór_1.Value Then
prywatne = "tak"
Else
Informatyka  programowanie, Politechnika Świętokrzyska str. 2
prywatne = "nie"
End lf
If wybór_2.Value Then
zarobkowe = "tak"
Else
zarobkowe = "nie"
End If
If wybór_3.Value Then
ile_lat = "tak"
Else
ile_lat = "nie"
End If
If wybór_4.Value Then
kupno = "tak"
Else
kupno = "nie"
End If
With Worksheets("ankieta")
.Range("lp").0ffset(liczba_wpisów, 0).Value = liczba_wpisów
.Range("wiek").0ffset(liczba_wpisów, 0).Value = pole_3.Text
.Range("wykształcenie").0ffset(liczba_wpisów, 0).Value =
Lista_2.List(Lista_2.ListIndex)
.Range("marka").0ffset(liczba_wpisów, 0).Value = pole_1.Text
.Range("uwagi").0ffset(liczba_wpisów, 0).Value = pole_2.Text
.Range("zadowolenie").0ffset(liczba_wpisów, 0).Value =
CInt(etykieta_1 .Caption)
.Range("płeć").0ffset(liczba_wpisów, 0).Value = płeć
.Range("prywatne").0ffset(liczba_wpisów, 0).Value = prywatne
.Range("zarobkowe").0ffset(liczba_wpisów, 0).Value = zarobkowe
.Range("ile_lat").Offset(liczba_wpisów, 0).Value = ile_lat
.Range("kupno").0ffset(liczba_wpisów, 0).Value = kupno
End With
czyszczenie
End Sub
13. W oknie kodu dla formularza wybierz z pola wyboru po lewej UserForm, z pola wyboru po prawej Activate i
wpisz treść procedury. Procedura będzie uruchamiana przy każdorazowej aktywacji formularza (okna dialogu).
Private Sub UserForm_Activate()
czyszczenie
etykieta_2.Caption=Worksheets("ankieta").Range("liczba").Value + 1
End Sub
14. Zmodyfikuj wpis do pola etykieta_2, tak aby był zgodny z zamieszczonym wzorem formularza.
PROCEDURY DLA SKOROSZYTU
15. Klikając dwukrotnie ThisWorkBook w oknie VBA-Project przejdz
do edycji procedur skoroszytu. W oknie
programu wybierz z listy po lewej Workbook , z listy po prawej Open i wpisz treść procedury:
Private Sub Workbook_Open()
Application.DisplayFullScreen = True
Worksheets("tytuł").Select
Range("a1").Select
End Sub
Procedura ta pełni funkcję procedury AutoOpen. Uruchamiana jest przy otwieraniu skoroszytu.
16. Analogicznie wprowadz
procedurę uruchamianą przed zamknięciem skoroszytu:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayFullScreen = False
End Sub
17. Wpisz procedury uruchomienie (uaktywniającą formularz ankiety) oraz koniec (zamykającą skoroszyt).
Sub uruchomienie()
Worksheets("tło").Select
Range("a1").Select
ANKIETA.Show
End Sub
Informatyka  programowanie, Politechnika Świętokrzyska str. 3
Sub koniec()
ActiveWorkbook.Close
End Sub
W arkuszu tytuł umieść dwa przyciski z napisami: wprowadzanie danych oraz koniec i przypisz do nich procedury,
odpowiednio, uruchomienie oraz koniec.
ANALIZA DANYCH ANKIETOWYCH
18. Wstaw Moduł1. W module tym będą procedury analizy danych ankietowych oraz usuwania danych dla prowadzenia
nowych badań ankietowych.
19. Napisz procedurę wybór_marki. Procedura ta nadaje nazwę marka_blok dla zakresu komórek z ankiety
zawierających nazwy samochodów. Zakres ten zwiększa się przy wpisywaniu kolejnych danych.
Option Explicit
Sub wybór_marki()
Dim obszar As String, numer As Integer
numer = Worksheets("ankieta").Range("liczba").Value + 3
obszar = "=ankieta!R4C6:R" & numer & "C6"
ActiveWorkbook.Names.Add Name:="marka_blok", RefersToR1C1 :=obszar
End Sub
20. W arkuszu baza w komórce B2 wprowadz
funkcję obliczającą ile samochodów w zakresie marka_blok ma taką
nazwę jak jest w komórce A2 arkusza baza, =LICZ.JEŻELI(marka_blok ; A2). Skopiuj tą formułę do całego
zakresu B2:B11.
21. W arkuszu baza, w komórce A12 wpisz słowo Inne, a w komórce B12 wpisz =liczba-SUMA(B2:B11)
22. Wstaw wykres na oddzielnym arkuszu (Wykres1). Jako zakres wykresu wstaw A2:B12. Wybierz wykres
kolumnowy.
23. Napisz procedury do_tytułu oraz wyniki_ankiety.
Sub do_tytułu()
Worksheets("tytuł").Select
End Sub
Sub wyniki_ankiety()
wybór_marki
Sheets("Wykres1").Select
End Sub
24. W arkuszu tytuł wstaw przycisk i połącz go z procedurą wyniki_ankiety. W arkuszu Wykres1 umieść
przycisk i połącz go z procedurą do_tytułu.
PRZYGOTOWANIE NOWEJ ANKIETY
25. Napisz procedurą nowa_ankieta Procedura ta usuwa dane z arkusza Ankieta po podaniu hasła.
Sub nowa_ankieta()
Dim obszar As String, numer As Integer, hasło As String
Dim przyciski As Integer, wybrany_przycisk As Integer
przyciski = vbYesNo + vbCritical + vbDefaultButton2
wybrany_przycisk = MsgBox(prompt:="Dotychczasowe dane będą usunięte," &
Chr(13) & "czy chcesz je usunąć?", Title:="NOWA ANKIETA",
Buttons:=przyciski)
If wybrany_przycisk = vbNo Then Exit Sub
MsgBox prompt:="Przypomnij sobie hasło", Title:="NOWA ANKIETA"
hasło = InputBox(prompt:="Podaj hasło", Title:="USUWANIE DANYCH")
If hasło = "trabant" Then
numer = Worksheets("ankieta").Range("liczba").Value
obszar = "=ankieta!B4:L" & numer + 3
Worksheets("ankieta").Range(obszar).ClearContents
Range("liczba").Value = 0
Exit Sub
End If
MsgBox prompt:="nie znasz hasła, nie usuniesz danych", Title:="DANE
POZOSTAJ
"
End Sub
26. W arkuszu tytuł umieść przycisk i połącz go z procedurą nowa_ankieta.
27. Sprawdz
działanie programu i przeprowadz
badania ankietowe.
28. Napisz własne procedury do analizy danych ankietowych
Informatyka  programowanie, Politechnika Świętokrzyska str. 4