Aplicatii VBA

In acest capitol vom realiza o serie de aplicatii ce se pot constitui in puncte de plecare pentru realizarea unor aplicatii personalizate, in functie de necesitatile fiecarui utilizator in parte.

1. Aplicatia 1 - Afisarea valorii si adresei celulei curente

Aceasta aplicatie va afisa noua valoare si adresa unei celule ori de cate ori este modificata.

Pentru acesta vom apela la evenimentul Change al foii de lucru curente (WorkSheet). Acest eveniment este declansat dupa ce valoarea unei celule a fost modificata.

Observatie

Intotdeauna obiectul care desemneaza foaia de lucru activa din lista derulanta cu controale indiferent de numele acesteia este WorkSheet.

Pentru realizarea acestei aplicatii nu este nevoie de nici un control, ci trebuie doar editat un cod pentru evenimentul Change al foii de calcul.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim adresa_cel As Variant

Dim continut_cel As Variant

Dim mesaj As String

adresa_cel = Target.Address

continut_cel = Target.Value

mesaj = 'Valoarea celulei ' + Cstr(adresa_cel) + ' este acum ' + Cstr(continut_cel)

MsgBox mesaj

End Sub

Daca modificam valoarea unei celule va fi afisat un mesaj care contine adresa si noua valoare a celulei.

2. Aplicatia 2 - Calcularea numarului inregistrarilor nevide dintr-o foaie de calcul

Vom realiza o aplicatie care va afisa numarul de inregistrari nevide ale unei foi de calcul presupunand ca acestea sunt asezate in ordine. Numarul de inregistrari va fi afisat folosind un buton de comanda. Pentru a afla numarul de inregistrari nevide construim o functie care returneaza acest numar.

Private Function numar_inr() As Integer

Dim inc as Integer

inc = 1

Do While Feuil1.Cells(inc, 1) <> ''

inc = inc + 1

Loop

numar_inr = inc - 1

End Function

Aceasta functie foloseste o variabila inc care se incrementeaza atata timp cat continutul celulei din linia inc si coloana 1, nu este nul. Dupa ce instructiunea While este executata valoarea returnata de functie este egala cu valoarea variabilei inc-1.

Observatie

Valoarea returnata de functie este inc-1 deoarece incrementarea s-a inceput de la 1 si nu de la zero.

Incrementarea se incepe de la unu deoarece celula cu adresa (0, 1) nu exista.

In continuare vom scrie codul pentru evenimentul Click al butonului de comanda.

Private Sub CommandButton1_Click()

Dim nr as Integer

nr = numar_inr

MsgBox nr

End Sub

Valoarea returnata prin apelarea functiei numar_inr este retinuta in variabila nr, care va fi afisata pe ecran.

3. Aplicatia 3 - Cautarea automata a unui cuvant citit de la tastatura

Vom realiza o aplicatie care va cauta intr-o foaie de calcul un cuvant (citit de la tastatura) si va returna un mesaj daca acest cuvant este gasit sau un alt mesaj daca nu este gasit. Afisarea rezultatelor se va face cu ajutorul unui buton de comanda. Pentru realizarea acestei aplicatii vom folosi functia din aplicatia 4 - numar_inr.

Dim nume_c As String

Dim apar As Integer

Dim msj As String

Dim k As Integer

Private Sub CommandButton1_Click()

nume_c = InputBox('Introduceti numele : ')

For k = 1 To numar_inr

If ActiveSheet.Cells(k, 1) = nume_c Then

apar = apar + 1

ActiveSheet.Cells(k, 1).Interior.Color = vbGreen

End If

Next k

If apar <> 0 Then

msj = 'Numele ' + nume_c + ' a fost gasit de ' + CStr(apar) + ' ori'

MsgBox msj

Else

msj = 'Numele ' + nume_c + ' nu a fost gasit'

MsgBox msj

End If

End Sub

Private Function numar_inr() As Integer

Dim inc As Integer

inc = 1

Do While ActiveSheet.Cells(inc, 1) <> ''

inc = inc + 1

Loop

numar_inr = inc - 1

End Function

TEMA: -Inserarea a inca 2 coloane si cautarea dupa oricare dintre ele.

-Folosirea functiilor Ucase si Lcase.

-Introducerea unor butoane radio in functie de care sa se coloreze rezultatele.

-Afisarea in etichete a rezultatului gasit si de cate ori a fost gasit.

In variabila nume_c este retinuta valoarea citita de la tastatura, iar in variabila apar sunt retinute numarul de aparitii al numelui cautat - nume_c. Daca valoarea lui apar este diferita de zero atunci inseamna ca numele a fost gasit de un numar de ori, iar celulele unde apare acest nume vor fi colorate in rosu si este afisat un mesaj. Daca valoarea variabilei apar este zero atunci numele nu a fost gasit si este afisat un alt mesaj.

4. Aplicatia 4 - Folosirea casetei lista si controlului de tip lista derulanta.

Caseta lista (list box) si controlul de tipul lista derulanta (combo box) ofera utilizatorilor posibilitatea de a alege obiecte dintr-o lista. Exista doua diferente majore intre un combo box si un list box. Prina diferenta o constituie faptul ca lista derulanta arata continutul numai atunci cand este desfasurata (click pe sageata din dreapta listei). A doua diferenta este ca din caseta lista se pot selecta mai multe obiecte, in timp ce folosind controlul de tipul lista derulanta se poate selecta un singur obiect.

Pentru a ilustra lucrul cu liste vom crea un exemplu ce va contine urmatoarele obiecte:

Un formular UserForm1, un buton de comanda CommandButton1, o lista combo ComboBox1 si o lista simpla ListBox1, ca in figura de mai jos:

Aplicatia va functiona astfel:

La deschiderea fisierului Excel va fi afisat formularul UserForm1.

La fiecare apasare de buton va fi incarcat in cele doua liste ComboBox1 si ListBox1 un sir de caractere de forma "modelXX", unde XX este un numar generat aleator cuprins intre 1 si 20.

Codul este urmatorul:

Private Sub Workbook_Open()

UserForm1.Show

End Sub

Dim nume_nou As String

Dim msg As String

Dim nr As Integer

Private Sub CommandButton1_Click()

nr = Int(20 * Rnd) + 1 ' genereaza un nr. intreg aleator intre 1 si 20

nume_nou = 'Model' + CStr(nr) ' CStr converteste variabilele numerice in variabile de tip sir

ComboBox1.AddItem nume_nou

ListBox1.AddItem nume_nou

End Sub

TEMA: -Sa se introduca in foaua de calcul un firmular.

-Introducere de butoane in acesta (ComboBox , ListBox , ComandButon.)

-Apelarea formularului in alta foaie de calcul cu ajutorul unui buton.

Aplicatia 5 - Actualizarea dinamica a unui grafic

Vom concepe o aplicatie care realizeaza actualizarea dinamica a unui grafic. Aceasta aplicatie este utila in cazul graficelor care sunt des modificate (sunt inserate randuri/inregistrari si coloane/campuri noi).

Aplicatia cuprinde o singura foaie de calcul pe care se afla 3 serii de date si un buton Command1 numit "Actualizare".

Codul corespunzator aplicatiei este urmatorul.:

Private Sub CommandButton1_Click()

Call cauta(nr_c, nr_r) ' determina cate randuri si coloane avem ocupate

zona = 'A1:' + Chr(64 + nr_c) + CStr(nr_r) ' Stabileste zona de date, iar chr(64) = 'A', chr(65)='B' etc.

Call grafic(zona) ' apeleaza functia de trasare a graficului

End Sub

Function cauta(c, r)

r = 1

Do Until Me.Cells(r, 1) = ''

r = r + 1

Loop

r = r - 1

c = 1

Do Until Me.Cells(1, c) = ''

c = c + 1

Loop

c = c - 1

End Function

Function grafic(z)

Range(z).Select 'selecteaza zona de date

On Error Resume Next 'in caz de eroare merge mai departe

Me.ChartObjects.Delete ' sterge toate graficele din foaia activa

Charts.Add 'creaza un grafic nou

' Observatie: Liniile de cod urmatoare au fost generate printr-un macro, iar dupa ce am observat logica lor am operat asupra lor modificarile dorite

With ActiveChart

.HasTitle = True

.ChartTitle.Characters.Text = 'Grafic productie' ' titlul graficului

.Axes(xlCategory, xlPrimary).HasTitle = True

.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = 'Zile' 'explicatia de pe abcisa (categorie)

.Axes(xlValue, xlPrimary).HasTitle = True

.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = 'Buc.' ' explicatie pentru ordonata (valoare)

.ChartType = xlLineMarkers ' indicam tipul graficului

.SetSourceData Source:=Sheets('Foaie1').Range(z), PlotBy:=xlColumns 'indicam sursa de date

.SeriesCollection(1).Name = '=''Depart.1''' ' Legenda

.SeriesCollection(2).Name = '=''Depart.2'''

.SeriesCollection(3).Name = '=''Depart.3'''

.Location Where:=xlLocationAsObject, Name:='Foaie1' ' indicam locatia graficului

'Observatie: Trebuie pastrata aceasta ordine in interiorul lui with end with

End With

End Function

TEMA: -Creati un tabel asemanator (din exemplu dat) cu actualizare automata.

-Pe graficul initial din exemplu; la "zile" sa scrie data si sa afiseze data din ziua resptiva.

-Titlul sa fie inserat dintr-o caseta text.

6. Aplicatia 6 - Crearea unui configurator automat

Vom concepe o aplicatie care realizeaza completarea unei liste de componente a caror valoare va fi insumata. Aplicatia este utila in realizarea de configuratii specifice pentru un echipament (automobil, calculator etc.) si calcularea pretului acestuia.

Aplicatia cuprinde doua foi de calcul. Prima foaie contine lista componentelor si preturile acestora, iar in foaia a doua se realizeaza calculul listei particularizate.

In prima foaie de calcul sunt doua butoane: unul pentru adaugare elemente, iar celalalt pentru reinitializare.

Codul corespunzator aplicatiei este:

1. Pentru prima foaie de calcul

Dim cnt As Integer

Private Sub Adauga_Click() 'procedura se activeaza prin click pe butonul 'Adauga' (evenimentul click)

Dim x As Integer, y As Integer

Dim reper As String, valoare As Single 'Declarare variabile

cnt = cnt + 1 ' cnt= numar inregistrari adaugate in foaia 'Vizualizare'

x = ActiveCell.Row ' x = randul celulei active

y = ActiveCell.Column ' y = coloana celulei active

If y <> 1 Then

y = 1 aduce celula activa in coloana 1

End If

reper = Feuil1.Cells(x, y) ' reper = numele reperului selectat

valoare = Feuil1.Cells(x, y + 1) ' valoare = valoarea reperului selectat

Feuil2.Cells(cnt, 1) = reper ' se adauga numele reperului in

foaia 2 'Vizualizare' pe pozitia cnt

Feuil2.Cells(cnt, 2) = valoare ' se adauga valoarea reperului in foaia 2

'Vizualizare' pe pozitia cnt

Feuil2.Cells(1, 3) = cnt ' se retine numarul de inregistrari din lista

End Sub

Private Sub Terminare_Click() 'procedura se activeaza prin click pe butonul

'Terminare' (evenimentul click)

cnt = 0 'se initializeaza contorul ce retine nr.de inregistrari

Feuil2.Activate ' este activata foaia 2 'Vizualizare'

Feuil2.Cells.Select 'sunt selectate toate celulele din foaia 2

Selection.ClearContents ' sterge continutul zonei selectate

Feuil2.Cells(1, 1).Select ' selecteaza prima celula

Feuil1.Activate ' revenire in foaia 1 'Introducere'

End Sub

2. Pentru a doua foaie de calcul

Dim cnt As Integer

Private Sub Worksheet_Activate() 'Procedura se executa prin activarea foii 2

'Vizualizare'

Dim adresa As String, sel As String 'Declararea variabilelor

If Feuil2.Cells(1, 3) <> '' Then

cnt = Feuil2.Cells(1, 3) + 1

Else

Exit Sub

End If

'se verifica daca exista inregistrari in foaia 2; daca sunt se adauga o linie pt.TOTAL; daca nu sunt inregistrari se iese din procedura

Feuil2.Cells(cnt, 1) = 'TOTAL' 'In foaia 2 pe randul cnt, coloana 1 se scrie

'TOTAL'

adresa = 'B' + CStr(cnt) ' se calculeaza pozitia celulei ce va contine valoarea

totala

sel = 'B1:B' + CStr(cnt - 1) ' variabila sel contine adresa zonei de celule ce

vor fi totalizate

Range(sel).Select ' este selectata zona de celule dupa care se va face totalul

Range(adresa).Activate 'Se activeaza celula unde va fi scris totalul

ActiveCell.Formula = '=SUM(' + sel + ')' ' in celula activa se insereaza

formula sum(sel)

Columns('A:A').EntireColumn.AutoFit ' se potriveste intreaga coloana la

marimea continutului

Columns('B:B').EntireColumn.AutoFit

End Sub

Tema: -Depanare program cu F8.

-Modificarea configuratorului prin adaugarea altor doua coloane (cantitate si valoare)

si a capatului de tabel.

7. Aplicatia 7 - Crearea unui formular si completarea automata a acestuia

Vom crea o aplicatie care realizeaza completarea automata a unei cereri, in functie de un nume care este citit de la tastatura. Aceasta aplicatie va folosi doua foi de calcul. In cea de-a doua foaie de calcul se introduc datele care sunt completate in cerere. In prima foaie de calcul este realizat sablonul care va fi completat. Acest sablon este format dintr-un antet si doua butoane de comanda. Primul buton va fi utilizat pentru completarea automata a datelor, iar cel de-al doilea pentru printarea acestei cereri. Pentru realizarea acestei aplicatii vom utiliza functiile numar_inr si gaseste din aplicatiile anterioare.

Codul corespunzator primei foi de calcul este urmatorul:

' Declar variabilele nrinreg - numar inregistrari si zona - zona cu date

Dim nrinreg As Integer: Dim zona As String

Private Sub Worksheet_Activate()

ListBox1.ColumnCount = 3

Call numar_inr(nrinreg)

zona = ('a1:c' & CStr(nrinreg))

ListBox1.List() = Foaie2.Range(zona).Value

Foaie1.Select

End Sub

Private Sub CommandButton1_Click()

'citirea datelor se face din list box, coloana 1, 2 sau 3

ListBox1.BoundColumn = 1

LbNume.Caption = ListBox1.Value

ListBox1.BoundColumn = 2

Lbsectia.Caption = ListBox1.Value

ListBox1.BoundColumn = 3

LbSalariu.Caption = ListBox1.Value

End Sub

Private Sub CommandButton2_Click()

Foaie1.PrintOut 1, 1, 1

End Sub

Private Function numar_inr(n) As Integer

Dim inc As Integer

inc = 1

Do While Foaie2.Cells(inc, 1) <> ''

inc = inc + 1

Loop

n = inc - 1

End Function

In evenimentul Click al butonului CommandButton2 este apelata metoda PrintOut a primei foi de calcul. Aceasta metoda are trei parametri: primul parametru(From) indica numarul pagini de la care incepe printarea, al doilea parametru(To) indica numarul pagini pana la se printeaza, iar cel de-al treilea reprezinta numarul de copii care este printat. In aceasta aplicatie este printata o singura pagina, intr-un singur exemplar. Prima foaie de calcul este prezentata in imaginea de mai jos:

Butonul CommandButton2

Butonul CommandButton1

Campuri care vor fi completate(celule care vor fi completate)

TEMA: -Depanare program cu F8.

-Adaugarea in formular a unei functii pentru a afisa intr-o celula colana INDEX

a listei cu angajati (nr de ordine al inregistrarii).

-introducera in baza de date a inca 2 coloane -CNP si -MARCA (Generate aleator).

-Completarea formularului prin dubluclick pe lista.

-Modificati proprietatile PrintObject.

-Crearea unui buton pentru completarea automata a formularului , pentru toate

inregistrarile din baza de date.

8. Aplicatia 8. -Crearea unui tabel pivot.

Una din problemele des intalnite in activitatea curenta este necesitatea crearii de tabele pivot.

Pentru a usura lucrul cu aceste tipuri de tabele vom imagina o aplicatie care ne va permite cu usurinta modificarea campurilor tabelului pivot.

Codul aplicatiei este urmatorul:

Dim campPag As String, campRow1 As String

Dim campCol1 As String, campDta As String

Dim camp

Dim Myarray(10)

Dim i As Integer, r As Integer

Private Sub Workbook_Open()

PivotFrm.pivotBtn.Enabled = False

i = 1

'Stabilim nr.de coloane nevide din foaia de lucru

camp = ActiveSheet.Cells(2, i)

Do While camp <> ''

camp = ActiveSheet.Cells(2, i)

i = i + 1

Loop

r = i - 3

'Stabilim nr.de coloane pentru listBox

PivotFrm.PivotLst.ColumnCount = 1

'Incarcam listBoxul cu date (aceste date sunt cele din capul de tabel)

For k = 0 To r

PivotFrm.PivotLst.AddItem (ActiveSheet.Cells(2, k + 1))

Next k

'Initializam campurile formularului

PivotFrm.PagTxt.Value = campPag

PivotFrm.RandTxt.Value = campRow1

PivotFrm.ColTxt.Value = campCol1

PivotFrm.DateTxt.Value = campDta

'Selectam primul element din listBox

PivotFrm.PivotLst.ListIndex = 0

'PivotFrm.PivotLst.List(k) = Myarray()

PivotFrm.Show

'PivotFrm.Visible = True

End Sub

Tabelul pivot obtinut va arata asemanator cu cel din imaginea de mai jos: