All pastes #2075620 Raw Edit

Stuff

public text v1 · immutable
#2075620 ·published 2011-06-06 15:49 UTC
rendered paste body
Pomoću ove forme ćemo unositi podatke o romanima radnil list Romani. Od podataka koje
unosimo imamo naslov romana, autora, godinu izdanja, cenu i žanr. Prva četiri podatka se unose
preko odgovarajućih tekst box-ova, dok se žanr unosi preko opcionih dugmadi. Dugme Unesi u
sheet služi da unese podatke u list. Naslove svih postojećih romana možemo prebaciti u list box,
a kasnije, na osnovu podataka iz list box-a, može kreirati novi radni list sa imenima romana i
podacima po želji (ček box-ovi ispod list box-a). Forma se zatvara pritiskom dugmeta Exit.
Dodatna funkcionalnost forme je mogućnost promene veličine fonta u tabeli sa romanima od 9
do 16 pt.
Dajemo ispod kompletan kod, a nakon toga i objašenjenje pojedinih elemenata.
Private Sub Workbook_Open()
Dim Dugme As CommandBarButton
Set Dugme = Application.CommandBars("Standard").Controls.Add( _
Type:=msoControlButton, Temporary:=True)
With Dugme
.Style = msoButtonCaption
.Caption = "Romani"
.OnAction = "Romani"
End With
End Sub
Sub Romani()
Dim I As Integer
FormRomani.Show vbModeless
FormRomani.TextNaslov.SetFocus
I = 1
Do While ActiveSheet.Cells(I, 1) <> ""
I = I + 1
Loop
ActiveSheet.Cells(I, 1).Activate
End Sub
Private Sub CommandBrisiElement_Click()
If Me.ListBoxRomani.ListIndex <> -1 Then
Me.ListBoxRomani.RemoveItem Me.ListBoxRomani.ListIndex
End If
End Sub
Private Sub CommandBrisiListu_Click()
Me.ListBoxRomani.Clear
End Sub
Private Sub CommandExit_Click()
Unload Me
End Sub
Private Sub CommandFormirajList_Click()
Dim I As Integer
Call CommandBrisiListu_Click
ActiveSheet.Range("A2").Activate
I = 2
Do While Cells(I, 1) <> ""
Me.ListBoxRomani.AddItem Cells(I, 1).Value
I = I + 1
Loop
End Sub
Private Sub CommandKreirajNoviSheet_Click()
Dim I As Integer, J As Integer, K As Integer
Dim NoviS As Worksheet, RomOpseg As Range
Set NoviS = Worksheets.Add(after:=Worksheets(Worksheets.Count))
NoviS.Name = "Romani" & Worksheets.Count
NoviS.Cells(1, 1).Value = "Naslov romana"
K = 1
If Me.CheckBoxAutor Then
K = K + 1
NoviS.Cells(1, K).Value = "Autor"
End If
If Me.CheckBoxGodina Then
K = K + 1
NoviS.Cells(1, K).Value = "Godina izdanja"
End If
If Me.CheckBoxCena Then
K = K + 1
NoviS.Cells(1, K).Value = "Cena"
End If
If Me.CheckBoxZanr Then
K = K + 1
NoviS.Cells(1, K).Value = ChrW(381) + "anr"
End If
Set RomOpseg = Worksheets("Romani").Range("A1").CurrentRegion
For I = 0 To Me.ListBoxRomani.ListCount - 1
K = 1
For J = 2 To RomOpseg.Rows.Count
If Me.ListBoxRomani.List(I) = RomOpseg.Cells(J, K) Then
K = 1
NoviS.Cells(I + 2, K).Value = RomOpseg.Cells(J, K).Value
If Me.CheckBoxAutor Then
K = K + 1
NoviS.Cells(I + 2, K).Value = RomOpseg.Cells(J, 2).Value
End If
If Me.CheckBoxGodina Then
K = K + 1
NoviS.Cells(I + 2, K).Value = RomOpseg.Cells(J, 3).Value
End If
If Me.CheckBoxCena Then
K = K + 1
NoviS.Cells(I + 2, K).Value = RomOpseg.Cells(J, 4).Value
End If
If Me.CheckBoxZanr Then
K = K + 1
NoviS.Cells(I + 2, K).Value = RomOpseg.Cells(J, 5).Value
End If
End If
Next
Next
End Sub
Private Sub CommandUnesi_Click()
Dim Odgovor As Integer
If Me.TextNaslov = "" Then
MsgBox "Mora se uneti naslov romana!", vbOKOnly, "Pogresan unos"
Exit Sub
End If
Odgovor = vbYes
If Me.TextAutor = "" Or Me.TextGodina = "" Or Me.TextCena = "" Then
Odgovor = MsgBox("Niste uneli sva polja." & vbCrLf & _
"Zelite li da nastavite?", vbYesNo, "Nepotpun unos")
End If
If Odgovor = vbYes Then
ActiveCell.Cells(1, 1).Value = Me.TextNaslov.Text
ActiveCell.Cells(1, 2).Value = Me.TextAutor.Text
ActiveCell.Cells(1, 3).Value = Me.TextGodina.Text
ActiveCell.Cells(1, 4).Value = Me.TextCena.Text
If Me.OptionAvantura Then ActiveCell.Cells(1, 5).Value = "Avantura"
If Me.OptionLjubavni Then ActiveCell.Cells(1, 5).Value = "Ljubavni"
If Me.OptionRatni Then ActiveCell.Cells(1, 5).Value = "Ratni"
If Me.OptionSF Then ActiveCell.Cells(1, 5).Value = "SF"
ActiveCell.Cells(2, 1).Activate
Me.TextNaslov.Text = ""
Me.TextAutor.Text = ""
Me.TextGodina.Text = ""
Me.TextCena.Text = ""
Me.TextNaslov.SetFocus
Else
If Me.TextNaslov = "" Then
Me.TextNaslov.SetFocus
ElseIf Me.TextAutor = "" Then
Me.TextAutor.SetFocus
Else
Me.TextCena.SetFocus
End If
End If
End Sub
Private Sub ScrollFont_Change()
Me.LabelFontSize2.Caption = "Izabrana velicina je " & _
ScrollFont.Value & " pt"
Range("A1").CurrentRegion.Font.Size = ScrollFont.Value
End Sub
U funkciji Workbook_Open smo dodali dugme Romani standardnoj paleti alatki i podesili da se
klikom na to dugme aktivara procedura Romani, koja je definisana u okviru standardnog VBA
modula. U okviru procedure Romani se prikazuje korisnička forma i inicijalizuju opciona
dugmad i klizač ScrollFont. Početna vrednost klizača kojim se definiše veličina fonta u tabeli
sa romanima je 9, i klikom na strelice se menja vrednost klizača za 1. Sa klizačem je povezana i
labela LabelFontSize2, koja prikazuje trenutnu vrednost veličine fonta. Sa Do While
petljom se pozicioniramo u prvu slobodnu ćeliju za upis. Uočimo korišćenje metode SetFocus
na tekst box-u TextNaslov. Pomoću ove metode se postiže da se, nakon startovanja korisničke
forme, kursor nalazi u ovom tekst box-u.
Unos podataka se vrši preko tekst box-ova TextNaslov, TextAutor, TextGodina i
TextCena. Pomoću dugmeta Unesi u sheet (CommandUnesi) se upisuju podaci za unetu knjigu.
Ukoliko ime knjige nije definisano javlja se poruka o greški prilikom unosa, dok ako nije
definisan neki drugi podatak, korisnik se pomoću message box-a pita da li želi da unese
nepotpune podatke. Pomoću grupe opcionih dugmadi OptionAvantura, OptionLjubavni,
OptionRatni i OptionSF se definiše žanr romana.
Naslovi romana iz radnog lista se pomoću dugmeta Ubaci u list box (CommandFormirajList)
mogu ubaciti u list box. Dodavanje elemenata u list box se vrši pomoću metode Additem. Pre
ubacivanja elemenata u listu vrši se brisanje čitave liste pozivanjem procedure
CommandBrisiListu_Click, koja pomoću metode Clear briše čitav list box.
Brisanje pojedinačnih elemenata iz list box-a se vrši dugmetom Brisi (CommandBrisiElement)
u kome se poziva metoda RemoveItem za brisanje elementa. Argument ove procedure je redni
broj elementa, pri čemu redni brojevi počinju od nule. Briše se selektovani element, a ukoliko
nijedan element nije selektovana, osobina ListIndex vraća -1.
Pomoću dugmeta Kreiraj novi sheet (CommandKreirajNoviSheet) se kreira novi radni list u
koji se upisuju samo oni romani koji se trenutno nalaze u list box-u. Šta će osim naslova knjiga
biti upisano zavisi od toga koji smo ček box štiklirali. Protumačite sami ovu proceduru.
Konačno, zatvaranje forme vrši dugme Exit (CommandExit) koje koristi naredbu Unload.