vbwexcelu

Programowanie w języku Visual Basic dla arkusza kalkulacyjnego Excel.

1. Wprowadzenie

W celu dostosowania arkusza kalkulacyjnego do swoich potrzeb,

uŜytkownik moŜe tworzyć tzw. Makra (skrót od makrokomendy), czyli
programy w języku Visual Basic.

Najprostszą i zarazem najprymitywniejszą formą tworzenia makra jest

automatyczne

rejestrowanie

czynności

wykonywanych

ręcznie

przez

uŜytkownika  na  arkuszu.  Takie  makro,  po  uruchomieniu  odtworzy  dokładnie
wszystkie  wykonane  operacje.  Powstaje  tylko  pytanie:  Po  co?  Skoro
utworzyliśmy  jakiś  formularz  ręcznie  –  moŜemy  go  zapisać  na  dysku  lub
dyskietce  i  korzystać  z  niego  tyle  razy  ile  zajdzie  potrzeba.  Opisane  wyŜej
makro  jest  tylko  inną  formą  przechowywania  formularza.  Makro  rejestrowane
automatycznie moŜe być uŜyteczne zwłaszcza wtedy gdy piszemy program i nie
wiemy  jak  zapisać  jakąś  funkcję  lub  operację.  Wystarczy  wtedy  wykonać  ją
ręcznie, rejestrując to jako makro. Następnie odczytujemy w programie w jakiej
formie została zapisana.

DuŜo waŜniejsza jest umiejętność świadomego programowania w języku

Visual Basic wtedy,  kiedy kształt formularza nie jest jednoznacznie określony,
np.  kiedy  obliczamy  pole  powierzchni  wieloboku  ze  współrzędnych  –  moŜe  to
być  czworobok,  pięciobok,  sześciobok  itd.  Za  kaŜdym  razem  potrzebny  jest
formularz  o  innych  wymiarach.  Podobnie,  kiedy  wykonujemy  obliczenie
ś

redniej arytmetycznej zgodnie z zasadami rachunku wyrównawczego, wraz z

oceną  dokładności  i  wszystkimi  kontrolami,  potrzebujemy  formularza  o
wymiarach  dostosowanych  do  liczby  uśrednianych  wielkości.  Innym
przykładem  moŜe  być  obliczenie  ciągu  poligonowego,  gdzie  liczba
wyznaczanych  punktów,  a  tym  samym  liczba  wierszy,  wpływa  w  sposób
decydujący  na  lokalizację  obliczeń  kontrolnych,  odchyłek  kątowych  oraz
liniowych.

W niniejszym rozdziale zostaną omówione podstawowe komendy w

Visual Basicu potrzebne do utworzenia formularza:

zaznaczanie pojedynczych pól lub ich grupy;

wstawianie napisów, wzorów i funkcji;

rysowanie ramek;

kopiowanie wyraŜeń w wierszach lub kolumnach;

tworzenie formularza o zadanych wymiarach;

wprowadzanie ochrony arkusza.

2. Tworzenie makr.

W celu rejestracji lub edycji makr naleŜy wejść do opcji Narzędzia Makro.
Następnie mamy do wyboru:

Makra

Zarejestruj nowe makro

Edytor Visual Basic

Edytor Visual Basic pozwala na pisanie treści programu

3 Podstawowe komendy makr w arkuszu kalkulacyjnym

Nie będziemy tu omawiać wszystkich zasad pisania programów w języku
Visual Basic. Skoncentrujemy się głównie na tych poleceniach i komendach,
które charakterystyczne są dla arkusza kalkulacyjnego.

Sub ... End Sub

KaŜde makro zaczyna się od linii w której występuje słowo kluczowe Sub
a następnie nazwa tego makro, np.:

Ostatnią linią tekstu danego makro jest pierwsza napotkana linia
zawierająca tekst End Sub

Zaznaczanie pól arkusza - Range("...").Select

KaŜda  operacja,  którą  wykonujemy  na  arkuszu  –  wstawianie  tekstu,
ramek,  funkcji  czy  wykresów  –  zaczyna  się  od  wskazania  pola  arkusza
lub  obszaru,  w  którym  dany  element  ma  zostać  umieszczony.  Kiedy
pracujemy „ręcznie”,  wybrane pole lub obszar zaznaczamy myszą.

Instrukcja  Range("  …  ").Select    umoŜliwia  zaznaczenie  na  arkuszu
pojedynczego pola, np.:

Range("B1").Select

lub całego zakresu pól, np.:

Range("B1:D6").Select

Wstawianie napisów - ActiveCell.FormulaR1C1 =

Niezbędnym elementem arkusza są wszelkiego rodzaju opisy,  ułatwiające
orientację  w  zadaniu  umieszczone  głównie  z  myślą  o  człowieku
uŜytkującym arkusz, gdyŜ komputer nie wykorzystuje ich do obliczeń.
W  celu  umieszczenia  na  arkuszu  napisu  naleŜy  zaznaczyć  wybraną
komórkę arkusza za pomocą instrukcji  Range(" … ").Select, a następnie
wstawić tekst za pomocą instrukcji ActiveCell.FormulaR1C1 =, np.:

    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Obliczenie średniej arytmetycznej"

Obie te instrukcje mogą być napisane w jednej linii, oddzielone
dwukropkiem:

    Range("A3").Select:    ActiveCell.FormulaR1C1 = "Nr"

lub połączone:

    Range("B3"). ActiveCell.FormulaR1C1 = "L"
    Range("C3"). ActiveCell.FormulaR1C1 = "l"

Parametry tekstu:

Po zaznaczeniu pojedynczego pola arkusza, lub większego obszaru
moŜemy zmieniać róŜne cechy tego obszaru posługując się słowem
Selection – co oznacza w tym wypadku zaznaczony obszar.

Np. Range("B2:D5").Select

- pogrubiona czcionka

włączanie -

Selection.Font.Bold = True

wyłączanie -

Selection.Font.Bold = False

- kursywa

włączanie -

Selection.Font.Italic = True

wyłączanie -

Selection.Font.Italic = False

- podkreślanie

włączanie - Selection.Font.Underline = xlUnderlineStyleSingle

wyłączanie - Selection.Font.Underline = xlUnderlineStyleNone

- justowanie tekstu

do lewej strony - Selection.HorizontalAlignment = xlLeft

na środek -

Selection.HorizontalAlignment = xlCenter

do prawej strony- Selection.HorizontalAlignment = xlRight

- zmiana fontu

Selection.Name = "Courier New CE"

Selection.Name = "Times New Roman CE"

- zmiana wielkości

Selection.Size = 10
Selection.Size = 14

indeks dolny (subscript) i górny (superscript)

w polu C9 wpisać v

    Range("C9").ActiveCell.FormulaR1C1 = "vi"

Z wpisanego tekstu wybiera się ciąg znaków o długości 1

poczynając od drugiego znaku.:

    With ActiveCell.Characters(Start:=2, Length:=1).Font
            .Subscript = True
     End With

w polu C10 wpisać a

    Range("C10").ActiveCell.FormulaR1C1 = "a2"

    With ActiveCell.Characters(Start:=2, Length:=1).Font
            .Superscript = True
     End With

Wstawianie wzorów i funkcji:

Występujące we wzorach symbole oznaczają odpowiednio:

R – wiersz
C – kolumna
R[-2] – dwa wiersze w górę
C[-5] – pięć kolumn w lewo

    B14:   =B12+B13/10000

    Range("B14").ActiveCell.FormulaR1C1 = "=R[-2]C+R[-1]C/10000"

    E10:   =SUMA(E4:E9)

    Range("E10").ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"

    F14:   =PIERWIASTEK(F10/(A9-1))

Range("F14").ActiveCell.FormulaR1C1 = "=SQRT(R[-4]C/(R[-5]C[-5]-1))"

    F15:   =F14/pierwiastek(A9)

    Range("F15").ActiveCell.FormulaR1C1 = "=R[-1]C/SQRT(R[-6]C[-5])"

     C4:   =(B4 - $B$12)*10000

    Range("C4").ActiveCell.FormulaR1C1 = "=(RC[-1]-R12C2)*10000"

Kopiowanie wzorów

Wzór z pola C4 kopiujemy do pól C4:C9:

Selection.AutoFill Destination:=Range("C4:C9"), Type:=xlFillDefault

Zmiana arkusza:

     Zmiana na Arkusz2

     Sheets("Arkusz2").Select

Rysowanie ramek:

W celu narysowania ramek zaznaczamy wybrany obszar arkusza, a następnie
rysujemy ramki – zewnętrzne i linie wewnętrzne:

   Rodzaje linii:

linia ciągła (.LineStyle = xlContinuous) ,

          linia kropkowana (.LineStyle = xlDot),
          linia kreskowana (.LineStyle = xlDash)
          linia kreska-kropka (.LineStyle = xlDashDot)
          linia kreska-kropka-kropka (.LineStyle = xlDashDotDot)
          linia podwójna (.LineStyle = xlDouble)

Grubości linii

gruba (.Weight = xlThick),
ś

rednia(.Weight = xlMedium),

cienka(.Weight = xlThin),

Zaznaczenie obszaru:

Range("A3:F9").Select

Rysowanie linii zewnętrznych:

- lewa ramka (xlEdgeLeft)

    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With

- górna ramka    (xlEdgeTop)

   With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With

- dolna ramka (xlEdgeBottom)

    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With

- prawa ramka  (xlEdgeRight)

    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With

Linie wewnętrzne:

- linie pionowe  (xlInsideVertical)

    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

- linie poziome (xlInsideHorizontal)

    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With

JeŜeli rysujemy ramki linią ciągłą (jest to parametr domyślny) i zmieniamy np.
tylko grubości, moŜemy to wszystko zapisać krócej:

Range("A3:F9").Select

With Selection

.Borders(xlEdgeLeft).Weight = xlThick
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeRight).Weight = xlThick
.Borders(xlInsideVertical) .Weight = xlThin
.Borders(xlInsideHorizontal). Weight = xlMedium

End With

Ochrona arkusza:

Zaznaczamy pola które nie mają być chronione – pola do wpisywania danych:

W polach B4:B9 będziemy wpisywać dane, a więc obszar ten nie moŜe być
zablokowany ani ukryty.

Range("B4:B9").Select

Selection.Locked = False

Selection.FormulaHidden = False

Następnie włączamy ochronę całego arkusza:

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Ewentualnie wprowadzone hasło nie jest zapisywane w programie. UŜytkownik
musi je podać ręcznie.

4. Przykład programu – obliczenie średniej arytmetycznej

Program pyta na początku o liczbę wartości do wyrównania:

Następnie

program

przygotowuje

formularz

obliczenia

redniej

arytmetycznej, oraz oceny jej dokładności dostosowany do podanej liczby
spostrzeŜeń. Wzory i tok obliczeń zostały omówione wcześniej przy ręcznym
tworzeniu formularza dla średniej arytmetycznej.

Sub srednia()

'**************** WYCZYSZCZENIE ZAWARTO

CI ARKUSZA *****

    ActiveSheet.Unprotect
    Range("A2:F30").Select
        Selection.Delete Shift:=xlUp


'**************** WSTAWIENIE TYTUŁU *******************
    Range("B1").Select
        Selection.Font.Bold = True
        Selection.Font.Italic = True
        ActiveCell.FormulaR1C1 = "Obliczenie

redniej arytmetycznej"

'******************* PYTANIE O LICZB

POMIARÓW *****************

Range("C2").Select
liczba = InputBox("Podaj liczbe warto

ci do u

rednienia")

lis = Trim(Str(liczba)):’ Str –zamiana liczby na string; Trim – usuwanie zb

dnych spacji

'****************** WSTAWIANIE OPISÓW TABELKI ***********************
    Range("A3").ActiveCell.FormulaR1C1 = "Nr"
    Range("B3").ActiveCell.FormulaR1C1 = "L"
    Range("C3").ActiveCell.FormulaR1C1 = "l"
    Range("D3").ActiveCell.FormulaR1C1 = "v"
    Range("E3").ActiveCell.FormulaR1C1 = "vv"
    Range("A4").ActiveCell.FormulaR1C1 = "1"
    Range("A5").ActiveCell.FormulaR1C1 = "2"

    Range("A3:E3").Select: Selection.HorizontalAlignment = xlCenter

'***************** WSTAWIANIE NUMERÓW POMIARÓW ********************
    ls = Trim(Str(liczba + 3))
    ra = "A4:A" + ls

    Range("A4:A5").Select
        Selection.AutoFill Destination:=Range(ra), Type:=xlFillDefault

    Range(ra).Select: Selection.HorizontalAlignment = xlCenter

'********** WSTAWIANIE NAPISU Xmin *****************
    r3 = "A" + Trim(Str(liczba + 5))
    Range(r3).Select
        Selection.Font.Bold = True
        ActiveCell.FormulaR1C1 = "xmin="
        With ActiveCell.Characters(Start:=2, Length:=3).Font.Subscript = True
        End With
        Selection.HorizontalAlignment = xlRight

'*********** WSTAWIANIE NAPISU DELTA X **************
    r4 = "A" + Trim(Str(liczba + 6))
    Range(r4).Select
        Selection.Font.Bold = True
        ActiveCell.FormulaR1C1 = "Dx="
        With ActiveCell.Characters(Start:=1, Length:=1).Font

.Name = "Symbol"

        End With
        Selection.HorizontalAlignment = xlRight

'********* WSTAWIANIE NAPISU X= **********************
    r5 = "A" + Trim(Str(liczba + 7))
    Range(r5).Select
        Selection.Font.Bold = True
        ActiveCell.FormulaR1C1 = "X="
        Selection.HorizontalAlignment = xlRight

'********** OBLICZENIE Xmin I  NADANIE NAZWY Xmin ************************
    r3 = "B" + Trim(Str(liczba + 5))
    Range(r3).Select
        ActiveCell.FormulaR1C1 = "=MIN(R[-7]C:R[-2]C)"
        ActiveWorkbook.Names.Add Name:="xmin"
        RefersToR1C1:="=Arkusz1!R" + Trim(Str(liczba + 5)) + "C2"

'*********** FORMATOWANIE PÓL Z DANYMI ******************
    rb = "B4:B" + Trim(Str(liczba + 5))
    Range(rb).Select
         Selection.NumberFormat = "0.00"
         Selection.HorizontalAlignment = xlRight
    Range("B4").Select

'*********** OBLICZANIE WARTO

CI l *********************

    Range("C4").ActiveCell.FormulaR1C1 = "=(RC[-1]-xmin)*100"

    rc = "C4:C" + Trim(Str(liczba + 3))
    Range("C4").Select
        Selection.AutoFill Destination:=Range(rc), Type:=xlFillDefault

'********** OBLICZANIE SUMY l ***************************
    Range("C" + Trim(Str(liczba + 4))).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-" + lis + "]C:R[-1]C)"

'********* OBLICZENIE DELTA X ******************
    rb = "B" + Trim(Str(liczba + 6))
    Range(rb).Select
    ActiveCell.FormulaR1C1 = "=R[-2]C[1]/" + lis
    ActiveWorkbook.Names.Add Name:="dx",

RefersToR1C1:="=Arkusz1!R" + Trim(Str(liczba + 6)) + "C2"

'********** OBLICZENIE X ************************
    rb = "B" + Trim(Str(liczba + 7))
    Range(rb).Select
    ActiveCell.FormulaR1C1 = "=R[-2]C+R[-1]C/100"

'********** FORMATOWANIE PÓL Dx i X ******************
    rb = "B" + Trim(Str(liczba + 6)) + ":B" + Trim(Str(liczba + 7))
    Range(rb).Select
         Selection.NumberFormat = "0.00"
         Selection.HorizontalAlignment = xlRight

'*********** OBLICZENIE V **********************
    Range("D4").Select:  ActiveCell.FormulaR1C1 = "=(dx-RC[-1])"
    rd = "D4:D" + Trim(Str(liczba + 3))
    Range("D4").Select
        Selection.AutoFill Destination:=Range(rd), Type:=xlFillDefault

'************ OBLICZENIE SUMY V **************************
    Range("D" + Trim(Str(liczba + 4))).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-" + lis + "]C:R[-1]C)"


'*********** OBLICZENIE VV *************************
    Range("E4").Select:  ActiveCell.FormulaR1C1 = "=RC[-1]^2"
    re = "E4:E" + Trim(Str(liczba + 3))
    Range("E4").Select
        Selection.AutoFill Destination:=Range(re), Type:=xlFillDefault


'************ OBLICZENIE SUMY VV **********************
    Range("E" + Trim(Str(liczba + 4))).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-" + Trim(Str(liczba)) + "]C:R[-1]C)"

'************ FORMATOWANIE PÓL V I VV ******************
   rb = "D4:E" + Trim(Str(liczba + 4))
    Range(rb).Select
         Selection.NumberFormat = "0.00"
         Selection.HorizontalAlignment = xlRight

'************ WSTAWIANIE NAPISÓW  m= i mx = ***********************

  rd = "D" + Trim(Str(liczba + 6))
    Range(rd).Select: ActiveCell.FormulaR1C1 = "m ="
    Selection.HorizontalAlignment = xlRight

  rd = "D" + Trim(Str(liczba + 7))
    Range(rd).Select
    ActiveCell.FormulaR1C1 = "mx ="
    ActiveCell.Characters(Start:=2, Length:=1).Font.Subscript = True

    Selection.HorizontalAlignment = xlRight

'************ OBLICZANIE WARTO

CI m= i mx = ***********************

   re = "E" + Trim(Str(liczba + 6))
    Range(re).Select
    ActiveCell.FormulaR1C1 = "=SQRT(R[-2]C/" + Trim(Str(liczba - 1)) + ")"

  re = "E" + Trim(Str(liczba + 7))
    Range(re).Select: ActiveCell.FormulaR1C1 = "=R[-1]C/SQRT(" + lis + ")"


'************ FORMATOWANIE PÓL m i mx ******************************
    rb = "E" + Trim(Str(liczba + 6)) + ":E" + Trim(Str(liczba + 7))
    Range(rb).Select
         Selection.NumberFormat = "0.0"

'**************** RYSOWANIE RAMEK *********************************
    r2 = "A3:E" + ls
    Range(r2).Select

        With Selection

.Borders(xlEdgeLeft).Weight = xlThick
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeRight).Weight = xlThick
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin

        End With


    '******** ZAZNACZENIE PÓL NIECHRONIONYCH **********
    rb = "B4:B" + ls
    Range(rb).Select
       Selection.Locked = False
       Selection.FormulaHidden = False
       Selection.Interior.ColorIndex = 27

    '*********** WŁ

CZENIE OCHRONY ARKUSZA **************

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

    Range("B4").Select
    End Sub

Po wykonaniu programu otrzymujemy gotowy formularz, do którego dane
wpisujemy w polach zaznaczonych Ŝółtym kolorem

.Interior.ColorIndex = 27

(pozostałe pola są chronione).

5.Obliczenie pola wieloboku ze współrzędnych wzorami Gaussa:

∑

⋅

−

⋅

Public Sub pola()

‘************  wyczyszczenie arkusza ****************
Range("A2:F30").Select
        Selection.Delete Shift:=xlUp

‘*************  wstawienie tytułu  ********************
    Range("B1").Select
     Selection.Font.Bold = True
     Selection.Font.Italic = True
     ActiveCell.FormulaR1C1 = "Obliczenie pola działki ze współrzędnych"

‘************** pytanie o liczbę punktów ******************
    Range("C2").Select
        liczba = InputBox("Podaj liczbę punktów na obwodzie działki")

‘************* opisy nagłówków tabeli ***********************
    Range("B3").Select
        Selection.Font.Bold = True
        ActiveCell.FormulaR1C1 = "X"
        Selection.HorizontalAlignment = xlCenter

    Range("C3").Select
        Selection.Font.Bold = True
        ActiveCell.FormulaR1C1 = "Y"
        Selection.HorizontalAlignment = xlCenter

  '*********** RYSOWANIE RAMEK ************************

  r1 = Trim(Str(liczba + 4))
  rr = "A3:C" + r1
  Range(rr).Select

  With Selection

.Borders(xlEdgeLeft).Weight = xlThick
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeRight).Weight = xlThick
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin

End With

‘********  dopisywanie na końcu tabeli pierwszego punktu *********

  Range("A" + r1).ActiveCell.FormulaR1C1 = "=R4C1"
  Range("B" + r1).ActiveCell.FormulaR1C1 = "=R4C2"
  Range("C" + r1).ActiveCell.FormulaR1C1 = "=R4C3"

  ‘****************** wstawianie napisu:     P=
  r2 = Trim(Str(liczba + 6))
  Range("A" + r2).Select:   ActiveCell.FormulaR1C1 = "P="
  Selection.HorizontalAlignment = xlRight


‘************ wstawianie wzoru Gaussa ***************
  Range("P5").Select
  ActiveCell.FormulaR1C1 = "=R[-1]C[-14]*RC[-13]-RC[-14]*R[-1]C[-13]"

‘********* kopiowanie wzoru Gaussa do następnych wierszy arkusza **
   rd = "P5:P" + r1
  Range(rd).Select
   Selection.AutoFill Destination:=Range(rd), Type:=xlFillDefault

‘****** obliczanie sumy składników wzoru Gaussa ***************
    Range("P" + r2).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-" + r1 + "]C:R[-2]C)"

‘******** wstawianie wyniku ******************************
      Range("B" + r2).Select:
     ActiveCell.FormulaR1C1 = "=ABS(RC[14])/2"


End Sub