'LISTING 8.1
Sub Komunikat()
MsgBox "To nasz pierwszy komunikat"
End Sub
'LISTING 8.2
Function Kwadrat(x)
Kwadrat = x * x
End Function
'LISTING 8.3
Sub Komunikat1()
b = 10
c = 5
a = b + c
MsgBox a
End Sub
'LISTING 8.4
Sub Komunikat2()
Dim a, b, c As Integer
b = 10
c = 5
a = b + c
MsgBox a
End Sub
'LISTING 8.5
Sub Komunikat3()
Dim a, b, c As Integer
Const Liczba = 15
Const tekst = "Suma = "
a = b + c + Liczba
MsgBox tekst & a
End Sub
'LISTING 8.6
Sub Wprowadzanie_danych()
Dim a, b, c As Integer
a = InputBox("Podaj liczbę a: ")
b = InputBox("Podaj liczbę b: ")
c = a - (-b)
MsgBox "Suma podanych liczb: " & c
End Sub
'LISTING 8.7
Sub Okna_operatory()
'Definiowanie zmiennych
Dim a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, r, s As Single
'Wprowadzenie pierwszej liczby
'Przypisanie funkcji InputBox do zmiennej a. Okno jest położone
'w centrum ekranu, ponieważ nie podane zostały argumenty xpos i ypos.
'Wartością domyślną jest 0.
a = InputBox( _
Title:="Działania arytmetyczne", _
prompt:="Podaj pierwszą liczbę: ", _
Default:=0)
'Wprowadzenie drugiej liczby
'Przypisanie funkcji InputBox do zmiennej b.
'Wartością domyślną jest 10.
'Argumenty xpos i ypos określają położenie okna na ekranie.
b = InputBox( _
Title:="Działania arytmetyczne", _
prompt:="Podaj drugą liczbę: ", _
Default:=10, _
xpos:=800, _
ypos:=1200)
'Obliczenie sumy podanych liczb. Wyrażenie powinno wyglądać c = a + b,
'ponieważ znak "+" jest również używany do łączenia danych, to
'w przypadku błędnej sumy należy wprowadzić równorzędne wyrażenie.
c = a - (-b)
'Przypisanie funkcji MsgBox do zmiennej d.
d = MsgBox( _
prompt:="Suma podanych liczb wynosi: " & c, _
Title:="Sumowanie wprowadzonych liczb", _
Buttons:=vbYesNo + vbInformation + vbDefaultButton1)
'Obliczenie różnicy pierwszej i drugiej liczby
e = a - b
'Przypisanie funkcji MsgBox do zmiennej f.
f = MsgBox( _
prompt:="Różnica pierwszej i drugiej liczby wynosi: " & e, _
Title:="Odejmowanie wprowadzonych liczb", _
Buttons:=0 + 16 + 0)
'Obliczenie iloczynu pierwszej i drugiej liczby
g = a * b
'Przypisanie funkcji MsgBox do zmiennej h.
h = MsgBox( _
prompt:="Iloczyn pierwszej i drugiej liczby wynosi: " & g, _
Title:="Odejmowanie wprowadzonych liczb", _
Buttons:=2 + 32 + 256)
'Obliczenie potęgi pierwszej liczby o wykładniku będącym drugą liczbą.
i = a ^ b
'Przypisanie funkcji MsgBox do zmiennej j.
j = MsgBox( _
prompt:="Pierwsza liczba podniesiona do potęgi o wykładniku" & _
"drugiej liczby: " & i, _
Title:="Potęgowanie liczby", _
Buttons:=51)
'Obliczenie ilorazu pierwszej i drugiej liczby.
k = a / b
'Przypisanie funkcji MsgBox do zmiennej l.
l = MsgBox("Iloraz pierwszej i drugiej liczby wynosi: " & k, 16, _
"Pełne dzielenie liczb")
'Obliczenie części całkowitej ilorazu pierwszej i drugiej liczby.
m = a \ b
'Przypisanie funkcji MsgBox do zmiennej n.
n = MsgBox("Część całkowita ilorazu pierwszej i drugiej liczby" & _
"wynosi: " & m, 16, "Część całkowita ilorazu liczb")
'Obliczenie reszty z dzielenia pierwszej i drugiej liczby.
o = a Mod b
'Przypisanie funkcji MsgBox do zmiennej p.
p = MsgBox("Reszta z dzielenia pierwszej i drugiej liczby wynosi: " _
& o, 16, "Reszta ilorazu liczb")
'Przypisanie funkcji MsgBox do zmiennej r.
'Obliczenie pierwiastka kwadratowego liczby a.
s = Sqr(a)
r = MsgBox("Pierwiastek kwadratowy pierwszej liczby wynosi: " & s, _
16, "Pierwiastek kwadratowy")
End Sub
'LISTING 8.8
Sub Warunek1_If_then()
Dim a, b, c As Integer
a = InputBox("Podaj liczbę a: ")
b = InputBox("Podaj liczbę b: ")
If a > 10 Then c = a * b
MsgBox "Iloczyn podanych liczb: " & c
End Sub
'LISTING 8.9
Sub delta()
Dim a, b, c, delta, x1, x2, o1, o2, o3 As Single
a = InputBox( _
Title:="Równanie kwadratowe ax2+bx+c", _
prompt:="Podaj a: ", _
Default:=0)
b = InputBox( _
Title:="Równanie kwadratowe ax2+bx+c", _
prompt:="Podaj b: ", _
Default:=0)
c = InputBox( _
Title:="Równanie kwadratowe ax2+bx+c", _
prompt:="Podaj c: ", _
Default:=0)
delta = b ^ 2 - 4 * a * c
o1 = MsgBox( _
prompt:="Delta = " & delta, _
Title:="Dla równania: y= " & a & "x2+" & b & "x+" & c, _
Buttons:=0 + 16)
If delta > 0 Then
x1 = (-b - Sqr(delta)) / 2 * a
x2 = (-b + Sqr(delta)) / 2 * a
o2 = MsgBox( _
prompt:="Pierwszy pierwiastek wynosi: " & x1 & _
"Drugi pierwiastek wynosi: " & x2, _
Title:="Rozwiązanie równania", _
Buttons:=0 + 64)
End If
o3 = MsgBox( _
prompt:="y= " & a & "x2+" & b & "x+" & c, _
Title:="Zakończono rozwiązanie równania: ", _
Buttons:=0 + 16)
End Sub
'LISTING 8.10
Sub Warunek1_If_then_else()
Dim a, b, c As Integer
a = InputBox("Podaj liczbę a: ")
b = InputBox("Podaj liczbę b: ")
If a > 10 Then
c = a * b
Else
c = a - b
MsgBox "Wynik działania: " & c
End Sub
'LISTING 8.11
Sub delta1()
Dim a, b, c, delta, x1, x2, x, o1, o2, o3, o4, o5 As Single
a = InputBox( _
Title:="Równanie kwadratowe ax2+bx+c", _
prompt:="Podaj a: ", _
Default:=0)
b = InputBox( _
Title:="Równanie kwadratowe ax2+bx+c", _
prompt:="Podaj b: ", _
Default:=0)
c = InputBox( _
Title:="Równanie kwadratowe ax2+bx+c", _
prompt:="Podaj c: ", _
Default:=0)
delta = b ^ 2 - 4 * a * c
o1 = MsgBox( _
prompt:="Delta = " & delta, _
Title:="Dla równania: y= " & a & "x2+" & b & "x+" & c, _
Buttons:=0 + 16)
If delta > 0 Then
x1 = (-b - Sqr(delta)) / 2 * a
x2 = (-b + Sqr(delta)) / 2 * a
o2 = MsgBox( _
prompt:="Pierwszy pierwiastek równania: " & x1 & "Drugi" & _
"pierwiastek równania: " & x2, _
Title:="Rozwiązanie równania y= " & a & "x2+" & b & "x+" & c, _
Buttons:=0 + 64)
ElseIf delta = 0 Then
x = -b / 2 * a
o3 = MsgBox( _
prompt:="Pierwiastek równania: " & x, _
Title:="Rozwiązanie równania y= " & a & "x2+" & b & "x+" & c, _
Buttons:=0 + 16)
Else
o4 = MsgBox( _
prompt:="Równanie nie ma pierwiastków - delta jest mniejsza od" & _
"zera. ", _
Title:="Równanie y= " & a & "x2+" & b & "x+" & c, _
Buttons:=0 + 16)
End If
o5 = MsgBox( _
prompt:="y= " & a & "x2+" & b & "x+" & c, _
Title:="Zakończono rozwiązanie równania: ", _
Buttons:=0 + 16)
End Sub
'LISTING 8.12
Sub Operator_And()
Dim a, b, c, d, e As Integer
a = InputBox( _
Title:="Operator logiczny And", _
prompt:="Podaj a (> 5): ", _
Default:=0)
b = InputBox( _
Title:="Operator logiczny And", _
prompt:="Podaj b (>= 15): ", _
Default:=0)
If a > 5 And b >= 15 Then
c = a * b
d = MsgBox( _
prompt:="Iloczyn liczb " & a & " i " & b & " wynosi: " & c, _
Title:="Warunek jest prawdziwy. ", _
Buttons:=0 + 64)
Else
e = MsgBox( _
prompt:="Nie obliczono iloczynu. ", _
Title:="Warunek jest fałszywy. ", _
Buttons:=0 + 48)
End If
End Sub
'LISTING 8.13
Sub Operator_Or()
Dim a, b, c, d, e As Integer
a = InputBox( _
Title:="Operator logiczny Or", _
prompt:="Podaj a (<= 10): ", _
Default:=0)
b = InputBox( _
Title:="Operator logiczny Or", _
prompt:="Podaj b (> 25): ", _
Default:=0)
If a <= 10 Or b > 25 Then
c = a * b
d = MsgBox( _
prompt:="Iloczyn liczb " & a & " i " & b & " wynosi: " & c, _
Title:="Warunek jest prawdziwy. ", _
Buttons:=0 + 64)
Else
e = MsgBox( _
prompt:="Nie obliczono iloczynu. ", _
Title:="Warunek jest fałszywy. ", _
Buttons:=0 + 48)
End If
End Sub
'LISTING 8.14
Sub Operator_Imp()
Dim a, b, c, d, e As Integer
a = InputBox( _
Title:="Operator logiczny Imp", _
prompt:="Podaj a (<> 0): ", _
Default:=0)
b = InputBox( _
Title:="Operator logiczny Imp", _
prompt:="Podaj b (> 5): ", _
Default:=0)
If a <> 0 Imp b > 5 Then
c = a - b
d = MsgBox( _
prompt:="Różnica liczb " & a & " i " & b & " wynosi: " & c, _
Title:="Warunek jest prawdziwy. ", _
Buttons:=0 + 64)
Else
e = MsgBox( _
prompt:="Nie obliczono różnicy. ", _
Title:="Warunek jest fałszywy. ", _
Buttons:=0 + 48)
End If
End Sub
'LISTING 8.15
Sub Przyciski_okna()
Dim a As Single
Start:
a = MsgBox( _
prompt:="Tak - Komunikat: Wciśnięto przycisk Tak," & _
"Komunikat: Wciśnięto przycisk Nie," & _
"Anuluj - Koniec działania procedury", _
Title:="Sprawdzenie działania przycisków! ", _
Buttons:=vbYesNoCancel + vbInformation + vbDefaultButton1)
If a = vbYes Then
MsgBox "Wciśnięto przycisk Tak"
GoTo Start
End If
If a = vbNo Then
MsgBox "Wciśnięto przycisk Nie"
GoTo Start
End If
If a = vbCancel Then
Exit Sub
End If
End Sub
'LISTING 8.16
Sub Wybór()
Dim a, b As Integer
a = InputBox( _
Title:=" Instrukcja warunkowa Select Case. ", _
prompt:="Podaj wartość wyrażenia a: ", _
Default:=0)
Select Case a
Case 1
b = MsgBox( _
prompt:="Wartość a = 1", _
Title:=" Instrukcja warunkowa Select Case. ", _
Buttons:=vbYes + vbInformation)
Case Is = 2
b = MsgBox( _
prompt:="Wartość a = 2", _
Title:=" Instrukcja warunkowa Select Case. ", _
Buttons:=vbYes + vbInformation)
Case 4 To 10
b = MsgBox( _
prompt:="Wartość a >= 4 i <=10. ", _
Title:=" Instrukcja warunkowa Select Case. ", _
Buttons:=vbYes + vbInformation)
Case Else
b = MsgBox( _
prompt:="Wartość a > 10", _
Title:=" Instrukcja warunkowa Select Case. ", _
Buttons:=vbYes + vbInformation)
End Select
End Sub
'LISTING 8.17
Sub wybór_1()
Dim a As Byte
Dim b, c, d, e, f, g As Double
b = Range("B1").Value
c = Range("B2").Value
d = Range("B3").Value
e = Range("B4").Value
f = Range("B5").Value
a = InputBox( _
Title:="Instrukcja warunkowa Select Case.", _
prompt:="1-dodawanie, 2-odejmowanie, 3-mnożenie, 4-dzielenie, " _
& Chr(13) & Chr(10) & Chr(13) & Chr(10) & _
"Podaj wartość wyrażenia a: ", _
Default:=0)
Select Case a
Case 1
g = b + c + d + e + f
Range("A7").Value = "Suma ="
Range("B7").Value = g
Case 2
g = b - c - d - e - f
Range("A7").Value = "Różnica ="
Range("B7").Value = g
Case 3
g = Range("B1").Value * Range("B2").Value _
* Range("B3").Value * Range("B4").Value * Range("B5").Value
Range("A7").Value = "Iloczyn ="
Range("B7").Value = g
Case 4
g = b / c / d / e / f
Range("A7").Value = "Iloraz ="
Range("B7").Value = g
End Select
End Sub
'LISTING 8.18
Sub For_wypełnianie()
Dim okno As Single
Dim a, b, c As Byte
a = 1
b = 1
c = 0
Range("A1: K25").Clear
Start:
okno = MsgBox( _
prompt:="Tak - Wypełnianie, Anuluj - Koniec wypełniania.", _
Title:=" Wypełnianie komorek arkusza! ", _
Buttons:=vbYesNo + vbExclamation + vbDefaultButton1)
If okno = vbYes Then
For a = 1 To 10
Cells(a, b).Value = c + a
Next
b = b + 1
c = c + 10
GoTo Start
End If
If okno = vbNo Then
Exit Sub
End If
End Sub
'LISTING 8.19
Sub For_silnia_1()
Dim a, b, x As Integer
Dim n As Double
n = 1
a = InputBox( _
Title:=" Komenda warunkowa For Next.", _
prompt:="Podaj wartość n: ", _
Default:=0)
For x = 1 To a
n = n * x
Next
b = MsgBox( _
prompt:=" Wartość silni: " & n, _
Title:=" Komenda warunkowa For Next.", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.20
Sub For_1()
Dim a, b, c, x As Single
a = InputBox( _
Title:=" Komenda warunkowa For Next.", _
prompt:="Podaj wartość a: ", _
Default:=0)
b = InputBox( _
Title:=" Komenda warunkowa For Next.", _
prompt:="Podaj wartość b: ", _
Default:=0)
For x = 1 To b
a = a * 2
Next x
c = MsgBox( _
prompt:="Dwukrotność podanej liczby po " & b & " pętlach: " & a, _
Title:=" Komenda warunkowa For Next.", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.21
Sub For_2()
Dim a, b, c, x As Single
a = InputBox( _
Title:=" Komenda warunkowa For Next.", _
prompt:="Podaj wartość a: ", _
Default:=0)
For x = 20 To -10 Step -5.5
a = a + 100
If x < 0 Then
c = MsgBox( _
prompt:="Otrzymana wartość: " & a, _
Title:=" Komenda warunkowa For Next.", _
Buttons:=vbYes + vbInformation)
Next
End Sub
'LISTING 8.22
Sub Do_1()
Dim a, b, d As Single
Dim c As String
a = InputBox( _
Title:=" Komenda warunkowa Do While Loop.", _
prompt:="Podaj wartość a: ", _
Default:=0)
b = a
Do While b > 0
c = c + "A "
b = b - 1
Loop
d = MsgBox( _
prompt:=c & " Litera 'A' została wypisana " & a & " razy.", _
Title:=" Komenda warunkowa Do While Loop.", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.23
Sub Do_2()
Dim a, b, d, e As Single
Dim c As String
a = InputBox( _
Title:=" Komenda warunkowa Do Until Loop.", _
prompt:="Podaj wartość a: ", _
Default:=0)
b = a
Do Until b = 0
c = c + "B "
b = b - 1
d = MsgBox( _
prompt:=c, _
Title:=" Komenda warunkowa Do Until Loop.", _
Buttons:=vbYes + vbInformation)
Loop
e = MsgBox( _
prompt:=c & " Litera 'B' została wypisana " & a & " razy.", _
Title:=" Komenda warunkowa Do Until Loop.", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.24
Sub Do_3()
Dim a, b, d, e As Single
Dim c As String
a = InputBox( _
Title:=" Komenda warunkowa Do Loop While.", _
prompt:="Podaj wartość a: ", _
Default:=0)
b = a
Do
c = c + "C "
b = b - 1
d = MsgBox( _
prompt:=c, _
Title:=" Komenda warunkowa Do Loop While.", _
Buttons:=vbYes + vbInformation)
Loop While b > 0
e = MsgBox( _
prompt:=c & " Litera 'C' została wypisana " & a & " razy.", _
Title:=" Komenda warunkowa Do Loop While.", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.25
Sub Do_4()
Dim a, b, d, e As Single
Dim c As String
a = InputBox( _
Title:=" Komenda warunkowa Do Loop Until.", _
prompt:="Podaj wartość a: ", _
Default:=0)
b = a
Do
c = c + "D"
b = b - 1
d = MsgBox( _
prompt:=c, _
Title:=" Komenda warunkowa Do Loop Until.", _
Buttons:=vbYes + vbInformation)
Loop Until b = 0
e = MsgBox( _
prompt:=c & " Litera 'D' została wypisana " & a & " razy.", _
Title:=" Komenda warunkowa Do Loop Until.", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.26
Sub Do_5()
Dim a, b, d, e As Single
Dim c As String
a = InputBox( _
Title:=" Pętla zagnieżdżona.", _
prompt:="Podaj wartość a: ", _
Default:=0)
b = a
Do While b > 0
For e = 1 To a
c = c + "E"
Next e
b = b - 1
d = MsgBox( _
prompt:=c, _
Title:=" Pętla zagnieżdżona.", _
Buttons:=vbYes + vbInformation)
Loop
e = MsgBox( _
prompt:=c & " Litera 'E' została wypisana " & a * a & " razy.", _
Title:=" Pętla zagnieżdżona.", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.27
Sub Do_odwołania()
MsgBox "Wykonana została podprocedura Do_odwołania."
End Sub
Sub Odwołanie()
MsgBox "Chcę wywołać podprocedurę Do_odwołania."
Do_odwołania
MsgBox "Możesz w ten sposób wywoływać podprocedury."
End Sub
'LISTING 8.28
Sub Macierz_1()
Dim a(5) As Long
Dim b As Long
a(1) = 12
a(2) = 2
a(3) = 1
a(4) = 120
a(5) = 53
b = MsgBox( _
prompt:=" Kolejne elementy: " & a(1) & ", " & a(2) & ", " & a(3) _
& ", " & a(4) & ", " & a(5), _
Title:=" Bezpośrednie deklarowanie elementów macierzy! ", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.29
Sub Macierz_2()
Dim a(5) As Single
Dim b, c, d As Single
For c = 1 To 5
d = InputBox( _
Title:=" Wprowadzanie elementów macierzy! ", _
prompt:="Podaj wartość a(" & c & ") elementu wektora: ", _
Default:=0)
a(c) = d
Next
b = MsgBox( _
prompt:=" a(1)=" & a(1) & "; a(2)=" & a(2) & "; a(3)=" & a(3) _
& "; a(4)=" & a(4) & "; a(5)=" & a(5), _
Title:=" Kolejne wartości elementów macierzy! ", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.30
Sub Macierz_Iloczyn()
Dim x, y, z, iloczyn As Single
Dim a(3)
For x = 1 To 3
y = InputBox( _
Title:=" Obliczenie iloczynu elementów macierzy! ", _
prompt:="Podaj wartość a(" & x & "): ", _
Default:=0)
a(x) = y
Next
iloczyn = 1
For x = 1 To 3
iloczyn = iloczyn * a(x)
Next
z = MsgBox( _
prompt:=" Podane elementy wektora: (" & a(1) & ", " & a(2) & ")," & _
"(" & a(3) & ".iloczyn = " & iloczyn, _
Title:=" Obliczenie iloczynu elementów macierzy! ", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.31
Sub Macierz_Minimum_Pozycja()
Dim x, y, z, NrMin As Single
Dim a(5)
For x = 1 To 5
y = InputBox( _
Title:=" Najmniejszy element macierzy i jego pozycja! ", _
prompt:="Podaj wartość a(" & x & ") elementu wektora: ", _
Default:=0)
a(x) = y
Next
NrMin = 1
For x = 1 To 4
If a(x + 1) < a(NrMin) Then
NrMin = x + 1
End If
Next
z = MsgBox( _
prompt:=" Najmniejsza wartość: " & a(NrMin) & " numer " & NrMin, _
Title:=" Najmniejszy element macierzy i jego pozycja! ", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.32
Sub Macierz_Sortowanie()
Dim b, x, y, z, wsk, pom As Single
Dim a(5)
For x = 1 To 5
y = InputBox( _
Title:=" Sortowamie elementów macierzy! ", _
prompt:="Podaj wartość a(" & x & ") elementów macierzy: ", _
Default:=0)
a(x) = y
Next
Do
wsk = 0
For x = 1 To 4
If a(x + 1) > a(x) Then
wsk = 1
pom = a(x)
a(x) = a(x + 1)
a(x + 1) = pom
End If
Next x
Loop Until wsk = 0
z = MsgBox( _
prompt:=" Posortowane elementy: " & a(1) & ", " & a(2) & ", " & _
a(3) & ", " & a(4) & ", " & a(5), _
Title:=" Sortowamie elementów macierzy! ", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.33
Option Base 1
Sub Iloczyn_macierzy_dwuwymiarowych()
Dim a(2, 2), d(2, 2), e(2, 2) As Integer
Dim b, b1, c, c1, c2, x, y As Integer
'Wprowadzanie elementów 1-ej macierzy
For x = 1 To 2
For y = 1 To 2
b = InputBox( _
Title:=" Wprowadzanie elementów 1-ej macierzy! ", _
prompt:="Podaj wartość a(" & x & ", " & y & ")" & _
"elementu macierzy: ", _
Default:=0)
a(x, y) = b
Next y
Next x
c = MsgBox( _
prompt:="Elementy macierzy: a(1,1)=" & a(1, 1) & ", a(1,2)=" & _
a(1, 2) & ", a(2,1)=" & a(2, 1) = ", a(2,2)=" & a(2, 2), _
Title:=" Macierz dwuwymiarowa! ", _
Buttons:=vbYes + vbInformation)
'Wprowadzanie elementów 2-ej macierzy
For x = 1 To 2
For y = 1 To 2
b1 = InputBox( _
Title:=" Wprowadzanie elementów 2-ej macierzy! ", _
prompt:="Podaj wartość d(" & x & ", " & y & ") elementu" & _
"macierzy: ", _
Default:=0)
d(x, y) = b1
Next y
Next x
c1 = MsgBox( _
prompt:=" Elementy macierzy: d(1,1)=" & d(1, 1) & ", d(1,2)=" _
& d(1, 2) & ", d(2,1)=" & d(2, 1) & ", d(2,2)=" & d(2, 2), _
Title:=" Macierz dwuwymiarowa! ", _
Buttons:=vbYes + vbInformation)
'Iloczyn macierzy dwuwymiarowych
For x = 1 To 2
For y = 1 To 2
e(x, y) = a(x, y) * (d(x, y))
Next y
Next x
c2 = MsgBox( _
prompt:=" Elementy macierzy: e(1,1)=" & e(1, 1) & ", e(1,2)=" & _
e(1, 2) & ", e(2,1)=" & e(2, 1) & ", e(2,2)=" & e(2, 2), _
Title:=" Iloczyn macierzy dwuwymiarowych! ", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.34
Sub Suma_wierszy_macierzy()
Dim a(2, 2) As Integer
Dim d(2) As Integer
Dim b, c, c2, x, y, suma As Integer
'Wprowadzanie elementów 1-ej macierzy
For x = 1 To 2
For y = 1 To 2
b = InputBox( _
Title:=" Wprowadzanie elementów macierzy! ", _
prompt:="Podaj wartość a(" & x & ", " & y & ") elementu" & _
"macierzy: ", _
Default:=0)
a(x, y) = b
Next y
Next x
c = MsgBox( _
prompt:=" Elementy macierzy: a(1,1)=" & a(1, 1) & ", a(1,2)=" & _
a(1, 2) & ", a(2,1)=" & a(2, 1) & ", a(2,2)=" & a(2, 2), _
Title:=" Macierz dwuwymiarowa! ", _
Buttons:=vbYes + vbInformation)
'Suma wierszy macierzy
suma = 0
x = 1
Licz:
If x > 2 Then GoTo Nie_Licz
For y = 1 To 2
suma = suma - (-a(x, y))
d(x) = suma
Next y
x = x + 1
suma = 0
GoTo Licz
Nie_Licz:
c2 = MsgBox( _
prompt:=" Elementy macierzy: d(1)=" & d(1) & ", d(2)=" & d(2), _
Title:=" Suma wierszy macierzy! ", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.35
Sub Suma_kolumn_macierzy()
Dim a(2, 2) As Integer
Dim d(1, 2) As Integer
Dim b, c, c2, x, y, suma As Integer
'Wprowadzanie elementów 1-ej macierzy
For x = 1 To 2
For y = 1 To 2
b = InputBox( _
Title:=" Wprowadzanie elementów macierzy! ", _
prompt:="Podaj wartość a(" & x & ", " & y & ") elementu" & _
"macierzy: ", _
Default:=0)
a(x, y) = b
Next y
Next x
c = MsgBox( _
prompt:=" Elementy macierzy: a(1,1)=" & a(1, 1) & ", a(1,2)=" & _
a(1, 2) & ", a(2,1)=" & a(2, 1) & ", a(2,2)=" & a(2, 2), _
Title:=" Macierz dwuwymiarowa! ", _
Buttons:=vbYes + vbInformation)
'Suma kolumn macierzy
For y = 1 To 2
For x = 1 To 2
suma = suma - (-a(x, y))
d(1, y) = suma
Next x
suma = 0
Next y
c2 = MsgBox( _
prompt:=" Elementy macierzy: d(1)=" & d(1, 1) & ", d(2)=" & _
d(1, 2), _
Title:=" Suma kolumn macierzy! ", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.36
Sub Sortowanie_macierzy_wierszami_malejąco()
Dim a(3, 3) As Integer
Dim b, c, c1, x, y, pom As Integer
Dim wsk As Boolean
'Wprowadzanie elementów macierzy
For x = 1 To 3
For y = 1 To 3
b = InputBox( _
Title:=" Wprowadzanie elementów macierzy! ", _
prompt:="Podaj wartość a(" & x & ", " & y & ") elementu" & _
"macierzy: ", _
Default:=0)
a(x, y) = b
Next y
Next x
c = MsgBox( _
prompt:=" Elementy macierzy:" & _
"a(1,1)=" & a(1, 1) & ", a(1,2)=" & a(1, 2) & ", a(1,3)=" & a(1, 3) & "," & _
"a(2,1)=" & a(2, 1) & ", a(2,2)=" & a(2, 2) & ", a(2,3)=" & a(2, 3) & "," & _
"a(3,1)=" & a(3, 1) & ", a(3,2)=" & a(3, 2) & ", a(3,3)=" & a(3, 3), _
Title:=" Macierz dwuwymiarowa! ", _
Buttons:=vbYes + vbInformation)
Do
wsk = 0
For x = 1 To 3
For y = 1 To 2
If a(x, y) < a(x, y + 1) Then
wsk = 1
pom = a(x, y + 1)
a(x, y + 1) = a(x, y)
a(x, y) = pom
End If
Next
Next
Loop Until wsk = 0
c1 = MsgBox( _
prompt:=" Elementy macierzy:" & _
"a(1,1)=" & a(1, 1) & ", a(1,2)=" & a(1, 2) & ", a(1,3)=" & a(1, 3) & "," & _
"a(2,1)=" & a(2, 1) & ", a(2,2)=" & a(2, 2) & ", a(2,3)=" & a(2, 3) & "," & _
"a(3,1)=" & a(3, 1) & ", a(3,2)=" & a(3, 2) & ", a(3,3)=" & a(3, 3), _
Title:=" Macierz posortowana wierszami malejąco! ", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.37
Sub Sortowanie_macierzy_wierszami_na_przemian()
Dim a(3, 3) As Integer
Dim b, c, c1, x, y, z, pom As Integer
Dim wsk As Boolean
'Wprowadzanie elementów macierzy
For x = 1 To 3
For y = 1 To 3
b = InputBox( _
Title:=" Wprowadzanie elementów macierzy! ", _
prompt:="Podaj wartość a(" & x & ", " & y & ") elementu" & _
"macierzy: ", _
Default:=0)
a(x, y) = b
Next y
Next x
c = MsgBox( _
prompt:=" Elementy macierzy:" & _
"a(1,1)=" & a(1, 1) & ", a(1,2)=" & a(1, 2) & ", a(1,3)=" & a(1, 3) & "," & _
"a(2,1)=" & a(2, 1) & ", a(2,2)=" & a(2, 2) & ", a(2,3)=" & a(2, 3) & "," & _
"a(3,1)=" & a(3, 1) & ", a(3,2)=" & a(3, 2) & ", a(3,3)=" & a(3, 3), _
Title:=" Macierz dwuwymiarowa! ", _
Buttons:=vbYes + vbInformation)
For x = 1 To 3
z = x Mod 2
Do
wsk = 0
For y = 1 To 2
If z = 1 Then
If a(x, y) < a(x, y + 1) Then
wsk = 1
pom = a(x, y + 1)
a(x, y + 1) = a(x, y)
a(x, y) = pom
End If
End If
If z = 0 Then
If a(x, y) > a(x, y + 1) Then
wsk = 1
pom = a(x, y + 1)
a(x, y + 1) = a(x, y)
a(x, y) = pom
End If
End If
Next
Loop Until wsk = 0
Next
c1 = MsgBox( _
prompt:=" Elementy macierzy:" & _
"a(1,1)=" & a(1, 1) & ", a(1,2)=" & a(1, 2) & ", a(1,3)=" & a(1, 3) & "," & _
"a(2,1)=" & a(2, 1) & ", a(2,2)=" & a(2, 2) & ", a(2,3)=" & a(2, 3) & "," & _
"a(3,1)=" & a(3, 1) & ", a(3,2)=" & a(3, 2) & ", a(3,3)=" & a(3, 3), _
Title:="Macierz posortowana wierszami-1,3 malejąco, 2 rosnąco!", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.38
Sub Sort_MacMalej()
Dim a(3, 3) As Integer
Dim b, c, c1, x, y, x1, y1, pom As Integer
Dim wsk, wsk1 As Boolean
'Wprowadzanie elementów macierzy
For x = 1 To 3
For y = 1 To 3
b = InputBox( _
Title:=" Wprowadzanie elementów macierzy! ", _
prompt:="Podaj wartość a(" & x & ", " & y & ") elementu" & _
"macierzy: ", _
Default:=0)
a(x, y) = b
Next y
Next x
c = MsgBox( _
prompt:=" Elementy macierzy:" & _
"a(1,1)=" & a(1, 1) & ", a(1,2)=" & a(1, 2) & ", a(1,3)=" & a(1, 3) & "," & _
"a(2,1)=" & a(2, 1) & ", a(2,2)=" & a(2, 2) & ", a(2,3)=" & a(2, 3) & "," & _
"a(3,1)=" & a(3, 1) & ", a(3,2)=" & a(3, 2) & ", a(3,3)=" & a(3, 3), _
Title:=" Macierz dwuwymiarowa! ", _
Buttons:=vbYes + vbInformation)
Do
wsk = 0
wsk1 = 0
For x = 1 To 3
For y = 1 To 2
If a(x, y) < a(x, y + 1) Then
wsk = 1
pom = a(x, y + 1)
a(x, y + 1) = a(x, y)
a(x, y) = pom
End If
For x1 = 1 To 2
y1 = 1
If a(x1 + 1, y1) > a(x1, y1 + 2) Then
wsk1 = 1
pom = a(x1, y1 + 2)
a(x1, y1 + 2) = a(x1 + 1, y1)
a(x1 + 1, y1) = pom
y1 = y1 + 1
End If
Next
Next
Next
Loop Until wsk = 0 And wsk1 = 0
c1 = MsgBox( _
prompt:=" Elementy macierzy:" & _
"a(1,1)=" & a(1, 1) & ", a(1,2)=" & a(1, 2) & ", a(1,3)=" & a(1, 3) & "," & _
"a(2,1)=" & a(2, 1) & ", a(2,2)=" & a(2, 2) & ", a(2,3)=" & a(2, 3) & "," & _
"a(3,1)=" & a(3, 1) & ", a(3,2)=" & a(3, 2) & ", a(3,3)=" & a(3, 3), _
Title:=" Macierz posortowana malejąco! ", _
Buttons:=vbYes + vbInformation)
End Sub
'LISTING 8.39
Sub Zmienna_lokalna()
Dim a, suma As Integer
a = 10
suma = suma + a
MsgBox suma
End Sub
'LISTING 8.40
Sub Zmienna_modułu()
Dim a, suma As Integer
a = 10
b = 15
suma = suma + a + b
MsgBox suma
End Sub
'LISTING 8.41
Sub Zmienna_publiczna()
Dim a, suma As Integer
a = 10
b = 15
c = 25
suma = suma + a + b + c
MsgBox suma
End Sub
'LISTING 8.42
Sub Zmienna_publiczna()
Dim a, suma As Integer
a = 10
c = 25
suma = a + c
MsgBox suma
End Sub
'LISTING 8.43
Option Base 1
Sub Wyrazy_polskie()
Dim nr As Integer
nr = FreeFile
Open "c:\Wyrazy polskie.txt" For Output As #nr
Print #nr, "dom"
Print #nr, "chłopiec"
Print #nr, "dziewczyna"
Print #nr, "ulica"
Print #nr, "pies"
Close #nr
End Sub
Sub Wyrazy_angielskie()
Dim nr, a As Integer
nr = FreeFile
Open "c:\Wyrazy angielskie.txt" For Output As #nr
For a = 1 To 5
Print #nr, Cells(a, 1).Value
Next
Close #nr
End Sub
Sub Odczytanie_wyrazów()
Dim nr As Integer
Dim w1(5) As String
Dim w2(5) As String
nr = FreeFile
Open "c:\Wyrazy polskie.txt" For Input As #nr
Input #nr, w1(1)
Input #nr, w1(2)
Input #nr, w1(3)
Input #nr, w1(4)
Input #nr, w1(5)
Close #nr
Range("a1").Value = w1(1)
Range("a2").Value = w1(2)
Range("a3").Value = w1(3)
Range("a4").Value = w1(4)
Range("a5").Value = w1(5)
Open "c:\Wyrazy angielskie.txt" For Input As #nr
Input #nr, w2(1)
Input #nr, w2(2)
Input #nr, w2(3)
Input #nr, w2(4)
Input #nr, w2(5)
Close #nr
Range("b1").Value = w2(1)
Range("b2").Value = w2(2)
Range("b3").Value = w2(3)
Range("b4").Value = w2(4)
Range("b5").Value = w2(5)
End Sub
Sub Słownik()
Dim nr As Integer
nr = FreeFile
Open "c:\Słownik.txt" For Output As #nr
Print #nr, Range("a1").Value, Range("b4").Value
Print #nr, Range("a2").Value, Range("b5").Value
Print #nr, Range("a3").Value, Range("b3").Value
Print #nr, Range("a4").Value, Range("b1").Value
Print #nr, Range("a5").Value, Range("b2").Value
Close #nr
Range("a1", "b5").Select
Selection.Delete
Range("a1").Select
End Sub
Sub Odczytanie_słownika()
Dim nr As Integer
Dim w1(5) As String
nr = FreeFile
Open "c:\Słownik.txt" For Input As #nr
Input #nr, w1(1)
Input #nr, w1(2)
Input #nr, w1(3)
Input #nr, w1(4)
Input #nr, w1(5)
Close #nr
Range("a1").Value = w1(1)
Range("a2").Value = w1(2)
Range("a3").Value = w1(3)
Range("a4").Value = w1(4)
Range("a5").Value = w1(5)
End Sub
'LISTING 8.44
Option Base 1
Type Biblioteka
Autor As String * 30
Tytuł As String * 20
Ilość As Integer
End Type
'W pliku znaki sekwencyjne.txt zapisujemy trzy rekordy.
Sub Zapisz_znaki_sekwencyjne()
Dim nr As Integer
nr = FreeFile
Open "c:\znaki sekwencyjne.txt" For Output As #nr
Print #nr, "Ala ma kota, Ola psa." & vbCrLf _
& "Iza ma tygrysa. Krzysztof lwa." & vbCrLf _
& "Kot ma mysz, miskę i mleko."
Close #nr
End Sub
'LISTING 8.45
Sub Ilość_znaków_sekwencyjne()
Dim nr As Integer
nr = FreeFile
Dim znak, tekst, litera As String
Dim suma, sumaz, sumas, sumad, sumam, sumak, sumap As Byte
Dim w1(3) As String
Dim x, y As Byte
'Podajemy literę, której ilość wystąpień w pliku chcemy obliczyć
znak = InputBox("Podaj literę: ")
Open "c:\znaki sekwencyjne.txt" For Input As #nr
x = 1
'Pętla Do While Not będzie wykonywana do chwili osiągnięcia końca
'pliku. Wczytane zostaną kolejne rekordy.
Do While Not EOF(nr)
Line Input #nr, w1(x)
'Pętla For next będzie wykonywana do chwili osiągnięcia końca
'rekordu. Zmienna tekst odczyta od początku rekordu (od lewej
'strony) tyle znaków, ile wynosi wartość zmiennej y (czyli po
'każdym obiegu pętli o jeden znak więcej). Zmienna litera będzie
'zwracała jeden znak z prawej strony zawarty w zmiennej tekst.
For y = 1 To Len(w1(x))
tekst = Left(w1(x), y)
litera = Right(tekst, 1)
'Ilość wystąpień w pliku podanej litery (zmienna znak)
If znak = litera Then sumaz = sumaz + 1
'Ilość wszystkich liter
suma = suma + 1
'Ilość spacji
If litera = " " Then sumas = sumas + 1
'Ilość dużych liter
If litera = "A" Or litera = "Ą" Or litera = "B" _
Or litera = "C" Or litera = "Ć" Or litera = "D" _
Or litera = "E" Or litera = "Ę" Or litera = "F" _
Or litera = "G" Or litera = "H" Or litera = "I" _
Or litera = "J" Or litera = "K" Or litera = "L" _
Or litera = "Ł" Or litera = "M" Or litera = "N" _
Or litera = "O" Or litera = "Ó" Or litera = "P" _
Or litera = "R" Or litera = "S" Or litera = "Ś" _
Or litera = "T" Or litera = "U" Or litera = "V" _
Or litera = "W" Or litera = "X" Or litera = "Y" _
Or litera = "Z" Or litera = "Ż" _
Or litera = "Ź" Then sumad = sumad + 1
'Ilość małych liter
If litera = "a" Or litera = "ą" Or litera = "b" _
Or litera = "c" Or litera = "ć" Or litera = "d" _
Or litera = "e" Or litera = "ę" Or litera = "f" _
Or litera = "g" Or litera = "h" Or litera = "i" _
Or litera = "j" Or litera = "k" Or litera = "l" _
Or litera = "ł" Or litera = "m" Or litera = "n" _
Or litera = "o" Or litera = "ó" Or litera = "p" _
Or litera = "r" Or litera = "s" Or litera = "ś" _
Or litera = "t" Or litera = "u" Or litera = "v" _
Or litera = "w" Or litera = "x" Or litera = "y" _
Or litera = "z" Or litera = "ż" _
Or litera = "ź" Then sumam = sumam + 1
'Ilość kropek
If litera = "." Then sumak = sumak + 1
'Ilość przecinków
If litera = ", " Then sumap = sumap + 1
Next
x = x + 1
Loop
Close #nr
MsgBox "Ilość litery " & znak & ": " & sumaz & vbCrLf & _
"Ilość wszystkich znaków: " & suma & vbCrLf & "Ilość spacji: " & _
sumas & vbCrLf & "Ilość dużych liter: " & sumad & vbCrLf & _
"Ilość małych liter: " & sumam & vbCrLf & "Ilość kropek: " & sumak _
& vbCrLf & "Ilość przecinków: " & sumap
End Sub
Sub Zapisz_znaki_bezpośrednie()
Dim nr As Integer
nr = FreeFile
Dim Książki(3) As Biblioteka
Open "c:\znaki bezpośrednie.txt" For Random As #nr Len = _
Len(Książki(1))
Książki(1).Autor = "Eliza Orzeszkowa"
Książki(1).Tytuł = "Nad Niemnem"
Książki(1).Ilość = 14
Książki(2).Autor = "Bolesław Prus"
Książki(2).Tytuł = "Lalka"
Książki(2).Ilość = 21
Książki(3).Autor = "Adam Mickiewicz"
Książki(3).Tytuł = "Pan Tadeusz"
Książki(3).Ilość = 39
Put #nr, 1, Książki(1)
Put #nr, 2, Książki(2)
Put #nr, 3, Książki(3)
Close #nr
End Sub
Sub Ilość_znaków_bezpośrednie()
Dim nr As Integer
nr = FreeFile
Dim a, b, c, d As Integer
Dim tekst, litera, znak As String
Dim suma, sumaz, sumad, sumam As Integer
Dim Książki(3) As Biblioteka
Open "c:\znaki bezpośrednie.txt" For Random As #nr Len = _
Len(Książki(1))
'Oczytujemy długość pliku.
d = LOF(nr)
'Ze względu na jednakową długość każdego rekordu, ilość rekordów
'obliczymy dzieląc 'długość pliku przez długość rekordu
'(choć moglibyśmy tej ilości nie liczyć wiedząc z góry, że ilość
'rekordów wynosi trzy).
b = LOF(nr) / Len(Książki(1))
'Podajemy literę, której ilość wystąpień w pliku chcemy obliczyć
znak = InputBox("Podaj literę: ")
'W pętli odczytujemy kolejne rekordy.
For a = 1 To b
Get #nr, a, Książki(a)
'W pętli For next od 1 do wartości, jaką jest długość rekordu
'odczytujemy kolejne znaki rekordu. Ten odczyt komplikuje nam
'fakt występowania w strukturze pól, z tego względu porównywanie
'znaków musimy przeprowadzić dla każdego pola oddzielnie.
For y = 1 To Len(Książki(a))
tekst = Left(Książki(a).Autor, y)
litera = Right(tekst, 1)
'Ilość podanej litery
If znak = litera Then sumaz = sumaz + 1
'Ilość dużych liter
If litera = "A" Or litera = "Ą" Or litera = "B" _
Or litera = "C" Or litera = "Ć" Or litera = "D" _
Or litera = "E" Or litera = "Ę" Or litera = "F" _
Or litera = "G" Or litera = "H" Or litera = "I" _
Or litera = "J" Or litera = "K" Or litera = "L" _
Or litera = "Ł" Or litera = "M" Or litera = "N" _
Or litera = "O" Or litera = "Ó" Or litera = "P" _
Or litera = "R" Or litera = "S" Or litera = "Ś" _
Or litera = "T" Or litera = "U" Or litera = "V" _
Or litera = "W" Or litera = "X" Or litera = "Y" _
Or litera = "Z" Or litera = "Ż" _
Or litera = "Ź" Then sumad = sumad + 1
'Ilość małych liter
If litera = "a" Or litera = "ą" Or litera = "b" _
Or litera = "c" Or litera = "ć" Or litera = "d" _
Or litera = "e" Or litera = "ę" Or litera = "f" _
Or litera = "g" Or litera = "h" Or litera = "i" _
Or litera = "j" Or litera = "k" Or litera = "l" _
Or litera = "ł" Or litera = "m" Or litera = "n" _
Or litera = "o" Or litera = "ó" Or litera = "p" _
Or litera = "r" Or litera = "s" Or litera = "ś" _
Or litera = "t" Or litera = "u" Or litera = "v" _
Or litera = "w" Or litera = "x" Or litera = "y" _
Or litera = "z" Or litera = "ż" _
Or litera = "ź" Then sumam = sumam + 1
tekst = Left(Książki(a).Tytuł, y)
litera = Right(tekst, 1)
If znak = litera Then sumaz = sumaz + 1
'Ilość dużych liter
If litera = "A" Or litera = "Ą" Or litera = "B" _
Or litera = "C" Or litera = "Ć" Or litera = "D" _
Or litera = "E" Or litera = "Ę" Or litera = "F" _
Or litera = "G" Or litera = "H" Or litera = "I" _
Or litera = "J" Or litera = "K" Or litera = "L" _
Or litera = "Ł" Or litera = "M" Or litera = "N" _
Or litera = "O" Or litera = "Ó" Or litera = "P" _
Or litera = "R" Or litera = "S" Or litera = "Ś" _
Or litera = "T" Or litera = "U" Or litera = "V" _
Or litera = "W" Or litera = "X" Or litera = "Y" _
Or litera = "Z" Or litera = "Ż" _
Or litera = "Ź" Then sumad = sumad + 1
'Ilość małych liter
If litera = "a" Or litera = "ą" Or litera = "b" _
Or litera = "c" Or litera = "ć" Or litera = "d" _
Or litera = "e" Or litera = "ę" Or litera = "f" _
Or litera = "g" Or litera = "h" Or litera = "i" _
Or litera = "j" Or litera = "k" Or litera = "l" _
Or litera = "ł" Or litera = "m" Or litera = "n" _
Or litera = "o" Or litera = "ó" Or litera = "p" _
Or litera = "r" Or litera = "s" Or litera = "ś" _
Or litera = "t" Or litera = "u" Or litera = "v" _
Or litera = "w" Or litera = "x" Or litera = "y" _
Or litera = "z" Or litera = "ż" _
Or litera = "ź" Then sumam = sumam + 1
Next
'Obliczenie ilości książek
c = c + Książki(a).Ilość
Next
Close #nr
'Ilość wszystkich znaków
suma = sumad + sumam
'Wyniki obliczeń wyprowadzamy do komórek arkusza.
Range("a1").Value = "Ilość podanej litery: " & znak
Range("b1").Value = sumaz
If sumaz = 0 Then Range("b1").Value = 0
Range("a2").Value = "Długość pliku w bajtach"
Range("b2").Value = d
Range("a3").Value = "Ilość wprowadzonych liter"
Range("b3").Value = suma
Range("a4").Value = "Ilość dużych liter"
Range("b4").Value = sumad
Range("a5").Value = "Ilość małych liter"
Range("b5").Value = sumam
Range("a6").Value = "Ilość książek"
Range("b6").Value = c
End Sub
Sub Zapisz_znaki_binarne()
Dim nr As Integer
nr = FreeFile
Open "c:\znaki binarne.txt" For Binary As #nr
Put #nr, , "Ilość Książek 488"
Put #nr, , "Ilość Regałów 7"
Put #nr, , "Ilość Półek 84"
Close #nr
End Sub
Sub Ilość_znaków_binarne()
Dim nr As Integer
nr = FreeFile
Dim a, b As Integer
'Zmienna znak1 przechowa wprowadzony znak (może to być litera lub
'cyfra), którego ilość wystąpień w pliku zwróci zmiena sumaz.
Dim znak1, znak2 As String
'Zawartość pliku wczytamy do zmiennej dane, aby odczytać wszystkie dane
'musimy pamiętać o odpowiedniej długości tej zmiennej.
Dim dane As String * 100
Dim suma, sumac As Integer
'Zmienną sumaz deklarujemy jako zmienną uniwersalną Variant.
'Przy ilości podanego znaku większej od zera będzie ona liczbą, przy
'ilości równej zero tekstem.
Dim sumaz As Variant
Open "c:\znaki binarne.txt" For Binary As #nr
b = LOF(nr)
znak1 = InputBox("Podaj znak: ")
Get #nr, , dane
For a = 1 To b
'Funkcja Mid odczytuje z pliku jego fragment od miejsca
'określonego zmienną a i długości w tym przypadku 1. Możemy więc
'odczytać wszystkie znaki pojedynczo.
znak2 = Mid(dane, a, 1)
'Ilość wszystkich znaków
suma = suma + 1
'Ilość cyfr
If znak2 = "0" Or znak2 = "1" Or znak2 = "2" Or znak2 = "3" _
Or znak2 = "4" Or znak2 = "5" Or znak2 = "6" Or znak2 = "7" _
Or znak2 = "8" Or znak2 = "9" Then sumac = sumac + 1
'Ilość podanego znaku
If znak2 = znak1 Then sumaz = sumaz + 1
Next
Close #nr
If sumaz = 0 Then sumaz = "0"
MsgBox "Ilość podanego znaku " & znak & ": " & sumaz & vbCrLf _
& "Ilość wprowadzonych znaków: " & suma & vbCrLf _
& "Ilość cyfr: " & sumac
End Sub
'LISTING 8.46
Option Base 1
Type Biblioteka1
Autor As String * 30
Tytuł As String * 20
Ilość As Integer
End Type
Sub do_sortowania_sekwencyjne()
Dim nr As Integer
nr = FreeFile
Open "c:\do sortowania sekwencyjne.txt" For Output As #nr
Print #nr, "d"
Print #nr, "b"
Print #nr, "a"
Print #nr, "e"
Print #nr, "c"
Close #nr
End Sub
Sub sortowanie_sekwencyjne()
Dim nr As Integer
Dim w1(5) As String
Dim w2(5) As String
nr = FreeFile
Dim a As Byte
Open "c:\do sortowania sekwencyjne.txt" For Input As #nr
Input #nr, w1(1)
Input #nr, w1(2)
Input #nr, w1(3)
Input #nr, w1(4)
Input #nr, w1(5)
Close #nr
For a = 1 To 5
If w1(a) = "A" Or w1(a) = "a" Then w2(1) = w1(a)
Next
For a = 1 To 5
If w1(a) = "B" Or w1(a) = "b" Then w2(2) = w1(a)
Next
For a = 1 To 5
If w1(a) = "C" Or w1(a) = "c" Then w2(3) = w1(a)
Next
For a = 1 To 5
If w1(a) = "D" Or w1(a) = "d" Then w2(4) = w1(a)
Next
For a = 1 To 5
If w1(a) = "E" Or w1(a) = "e" Then w2(5) = w1(a)
Next
Open "c:\posortowane sekwencyjne.txt" For Output As #nr
Print #nr, w2(1)
Print #nr, w2(2)
Print #nr, w2(3)
Print #nr, w2(4)
Print #nr, w2(5)
Close #nr
End Sub
'W drugim pliku sortowanie jest już o wiele ciekawsze.
Sub do_sortowania_bezpośrednie()
Dim nr As Integer
nr = FreeFile
Dim Książki(3) As Biblioteka1
Open "c:\do sortowania bezpośrednie.txt" For Random As #nr _
Len = Len(Książki(1))
Książki(1).Autor = "Sienkiewicz"
Książki(1).Tytuł = "Potop"
Książki(1).Ilość = 14
Książki(2).Autor = "Konopnicka"
Książki(2).Tytuł = "Nasza szkapa"
Książki(2).Ilość = 32
Książki(3).Autor = "Reymont"
Książki(3).Tytuł = "Chłopi"
Książki(3).Ilość = 23
Put #nr, 1, Książki(1)
Put #nr, 2, Książki(2)
Put #nr, 3, Książki(3)
Close #nr
End Sub
Sub Sortowanie_bezpośrednie()
Dim nr As Integer
nr = FreeFile
Dim a, b, e, o1, o2, o3, o4, z(3), z1(3), rekord As Integer
Dim c, d, x(3), x1(3), y(3), y1(3) As String
Dim Książki(3) As Biblioteka1
Dim wsk As Boolean
rekord = 1
Open "c:\do sortowania bezpośrednie.txt" For Random As #nr _
Len = Len(Książki(1))
b = LOF(nr) / Len(Książki(1))
For a = 1 To b
Get #nr, a, Książki(a)
x(a) = Książki(a).Autor
y(a) = Książki(a).Tytuł
z(a) = Książki(a).Ilość
Next
Close #nr
o1 = MsgBox( _
prompt:="Tak - Autor, Nie - Ilość, Anuluj - Tytuł", _
Title:=" Wybieramy pole, w/g którego chcemu posortować rekordy.", _
Buttons:=vbYesNoCancel + vbQuestion)
If o1 = vbYes Then
o2 = MsgBox( _
prompt:="Tak - Rosnąco, Nie - Malejąco, Anuluj - Nie sortujemy", _
Title:=" Sortujemy rosnąco, czy malejąco? ", _
Buttons:=vbYesNoCancel + vbQuestion)
End If
If o2 = vbYes Then
For a = 1 To b
If Left(x(a), 1) = "K" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
rekord = rekord + 1
End If
Next
For a = 1 To b
If Left(x(a), 1) = "R" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
rekord = rekord + 1
End If
Next
For a = 1 To b
If Left(x(a), 1) = "S" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
End If
Next
End If
If o2 = vbNo Then
For a = 1 To b
If Left(x(a), 1) = "S" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
rekord = rekord + 1
End If
Next
For a = 1 To b
If Left(x(a), 1) = "R" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
rekord = rekord + 1
End If
Next
For a = 1 To b
If Left(x(a), 1) = "K" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
End If
Next
End If
If o2 = vbCancel Then Exit Sub
If o1 = vbNo Then
o3 = MsgBox( _
prompt:="Tak - Rosnąco, Nie - Malejąco, Anuluj - Nie sortujemy", _
Title:=" Sortujemy rosnąco, czy malejąco? ", _
Buttons:=vbYesNoCancel + vbQuestion)
End If
If o3 = vbYes Then
Do
wsk = 0
For a = 1 To b - 1
If z(a + 1) < z(a) Then
wsk = 1
c = x(a)
d = y(a)
e = z(a)
x(a) = x(a + 1)
y(a) = y(a + 1)
z(a) = z(a + 1)
x(a + 1) = c
y(a + 1) = d
z(a + 1) = e
End If
Next
Loop Until wsk = 0
For a = 1 To b
x1(a) = x(a)
y1(a) = y(a)
z1(a) = z(a)
Next
End If
If o3 = vbNo Then
Do
wsk = 0
For a = 1 To b - 1
If z(a + 1) > z(a) Then
wsk = 1
c = x(a)
d = y(a)
e = z(a)
x(a) = x(a + 1)
y(a) = y(a + 1)
z(a) = z(a + 1)
x(a + 1) = c
y(a + 1) = d
z(a + 1) = e
End If
Next
Loop Until wsk = 0
For a = 1 To b
x1(a) = x(a)
y1(a) = y(a)
z1(a) = z(a)
Next
End If
If o3 = vbCancel Then Exit Sub
If o1 = vbCancel Then
o4 = MsgBox( _
prompt:="Tak - Rosnąco, Nie - Malejąco, Anuluj - Nie sortujemy", _
Title:=" Sortujemy rosnąco, czy malejąco? ", _
Buttons:=vbYesNoCancel + vbQuestion)
End If
If o4 = vbYes Then
For a = 1 To b
If Left(y(a), 1) = "C" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
rekord = rekord + 1
End If
Next
For a = 1 To b
If Left(y(a), 1) = "N" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
rekord = rekord + 1
End If
Next
For a = 1 To b
If Left(y(a), 1) = "P" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
End If
Next
End If
If o4 = vbNo Then
For a = 1 To b
If Left(y(a), 1) = "P" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
rekord = rekord + 1
End If
Next
For a = 1 To b
If Left(y(a), 1) = "N" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
rekord = rekord + 1
End If
Next
For a = 1 To b
If Left(y(a), 1) = "C" Then
x1(rekord) = x(a)
y1(rekord) = y(a)
z1(rekord) = z(a)
End If
Next
End If
If o4 = vbCancel Then Exit Sub
Range("a1:b6").Delete
For a = 1 To b
Cells(a, 1).Value = x1(a)
Cells(a, 2).Value = y1(a)
Cells(a, 3).Value = z1(a)
Książki(a).Autor = x1(a)
Książki(a).Tytuł = y1(a)
Książki(a).Ilość = z1(a)
Next
Open "c:\posortowane bezpośrednie.txt" For Random As #nr _
Len = Len(Książki(1))
For a = 1 To b
Put #nr, a, Książki(a)
Książki(a).Autor = x1(a)
Książki(a).Tytuł = y1(a)
Książki(a).Ilość = z1(a)
Next
Close #nr
End Sub
'LISTING 8.47
Sub Obiekt()
ActiveCell.Value = 10
End Sub
'LISTING 8.48
Sub Range_1()
Range("C5").Value = 123
End Sub
'LISTING 8.49
Sub Range_2()
Range("B2", "H8").Value = 1230
End Sub
'LISTING 8.50
Sub Cells_1()
Cells(10, 2).Value = 12
End Sub
'LISTING 8.51
Sub Cells_2()
Cells(10, "C").Value = 13
End Sub
'LISTING 8.52
Sub Range_3()
Range(Cells(2, 2), Cells(24, 11)).Value = "ABC"
End Sub
'LISTING 8.53
Sub Sheets_1()
Sheets("Arkusz2").Name = "Arkusz drugi"
End Sub
'LISTING 8.54
Sub Sheets_2()
Sheets(3).Select
Range("B2", "J19").Value = "XYZ"
End Sub
'LISTING 8.55
Sub Sheets_3()
Sheets(1).Select
Sheets("Arkusz1").Name = "Jeden"
Range("A1").Value = "Mało"
Sheets(2).Select
Sheets("Arkusz2").Name = "Dwa"
Range("A1").Value = "Średnio"
Sheets(3).Select
Sheets("Arkusz3").Name = "Trzy"
Range("A1").Value = "Dużo"
End Sub
'LISTING 8.56
Sub Workbooks_1()
Workbooks("Vbexcel_4.xls").Worksheets("Arkusz1").Activate
Sheets("Arkusz1").Name = "Pierwszy"
Range("A1").Value = "Komórka A1"
End Sub
'LISTING 8.57
Sub Workbooks_2()
ActiveWorkbook.Protect
End Sub
'LISTING 8.58
Sub Workbooks_3()
Set Obiekt = Workbooks("Vbexcel_4.xls").Sheets("Pierwszy")
Obiekt.Activate
With Obiekt
.Range("A1").Value = 100
.Range("A2").Value = 200
.Range("A3").Value = 300
.Range("A4").Value = 400
.Range("A5").Value = 500
End With
End Sub
'LISTING 8.59
Sub Workbooks_4()
Workbooks.Open "C:\Vbexcel\Vbexcel_4.xls"
Sheets("Arkusz2").Activate
Sheets("Arkusz2").Name = "Drugi"
ActiveWorkbook.Close SaveChanges:=True
End Sub
'LISTING 8.60
Sub Workbooks_5()
Workbooks.Add
template = xlWorksheet
template = xlChart
Sheets("Arkusz1").Name = "Tylko jeden"
ActiveWorkbook.Close _
SaveChanges:=True, _
Filename:="c:\Nowy_plik.xls"
Application.Quit
End Sub
'LISTING 8.61
Sub Komórka_1()
Range("A1: C10").Select
With Selection
.Value = 123
.Font.Name = "Times New Roman"
.Font.Size = 16
.Font.ColorIndex = 3
.Font.Bold = True
.Font.Italic = True
.Font.Strikethrough = True
.Font.Underline = True
.Interior.ColorIndex = 6
End With
Range("A1").Select
End Sub
'LISTING 8.62
Sub Komórka_2()
Range("E2: G10").Select
'Lewa krawędź bloku komórek
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDash
.Weight = xlMedium
.ColorIndex = 3
End With
'Górna krawędź bloku komórek
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'Dolna krawędź bloku komórek
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDash
.Weight = xlMedium
.ColorIndex = 5
End With
'Prawa krawędź bloku komórek
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDash
.Weight = xlMedium
.ColorIndex = 7
End With
'Krawędzie pionowe wewnątrz bloku komórek
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDash
.Weight = xlMedium
.ColorIndex = 45
End With
'Krawędzie poziome wewnątrz bloku komórek
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDash
.Weight = xlMedium
.ColorIndex = 50
End With
End Sub
'LISTING 8.63
Sub Komórka_3()
Range("I2").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End Sub
'LISTING 8.64
Sub Komórka_4()
Range("I2").Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End Sub
'LISTING 8.65
Sub Makro4()
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End Sub
'LISTING 8.66
Sub Makro1()
Range("I4").Select
ActiveCell.FormulaR1C1 = "Rejestracja makra"
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
End Sub
'LISTING 8.67
Sub Autofit_1()
Sheets(1).Columns(1).AutoFit
Sheets(1).Rows(1).AutoFit
End Sub
'LISTING 8.68
Sub ColumnWith_1()
Dim a As Variant
a = InputBox( _
Title:="Rozmiar kolumny", _
prompt:="Podaj szerokość kolumny (standardowa: 8.43)", _
Default:="")
If a = "" Then Exit Sub
Sheets(2).Range("A1: K1").Select
Selection.ColumnWidth = a
Range("A1").Select
End Sub
'LISTING 8.69
Sub RowHeight_1()
Dim a As Variant
a = InputBox( _
Title:="Rozmiar wiersza", _
prompt:="Podaj wysokość wiersza (standardowa: 12.75)", _
Default:="")
If a = "" Then Exit Sub
Sheets(2).Range("1:20").Select
Selection.RowHeight = a
Range("A1").Select
End Sub
'LISTING 8.70
Sub Hidden_1()
Sheets(2).Range("A1: D1").Select
Selection.EntireColumn.Hidden = True
End Sub
'LISTING 8.71
Sub Hidden_2()
Sheets(2).Range("A1: D1").Select
Selection.EntireColumn.Hidden = False
Range("A1").Select
End Sub
'LISTING 8.72
Sub Hidden_3()
Static Wiersz As Boolean
Dim a As Boolean
If Wiersz = True Then a = False
If Wiersz = False Then a = True
Sheets(2).Range("A1: A7").Select
Selection.EntireRow.Hidden = a
If a = True Then Wiersz = True
If a = False Then Wiersz = False
Range("A1").Select
End Sub
'LISTING 8.73
Sub Autoformat_1()
Sheets(1).Range("B2: I15").AutoFormat xl3DEffects2
End Sub
'LISTING 8.74
Sub Fill_1()
Sheets(1).Range("B2").Value = 77
Sheets(1).Range("B2: B15").FillDown
Sheets(1).Range("B2: I15").FillRight
End Sub
'LISTING 8.75
Sub Copy_1()
Sheets(1).Range("B2:B15").Copy Sheets(1).Range("K2:15")
End Sub
'LISTING 8.76
Sub Cut_1()
Sheets(1).Range("K2: K15").Cut Sheets(2).Range("A1")
End Sub
'LISTING 8.77
Sub Paste_1()
Range("B2").Copy
Range("M6").Select
ActiveSheet.Paste
End Sub
'LISTING 8.78
Sub PasteSpecial_1()
'Skopiowanie komórki B2
Range("B2").Select
Selection.Copy
'Wstawienie "wszystkiego" do komórki B17
Range("B17").Select
Selection.PasteSpecial Paste = xlAll, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
'Wstawienie do komórki C17 tylko wartości
Range("C17").Select
Selection.PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
'Wstawienie do komórki D17 tylko formatu
Range("D17").Select
Selection.PasteSpecial Paste:=xlFormats, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
'Dodanie wartości dwóch komórek
Range("I2").Select
Selection.PasteSpecial Paste:=xlAll, _
Operation:=xlAdd, SkipBlanks:=False, _
Transpose:=False
'Ustanowienie łącza między komórką I17 i I2.
Range("I2").Select
Selection.Copy
Range("I17").Select
ActiveSheet.Paste Link:=True
Application.CutCopyMode = False
End Sub
'LISTING 8.79
Sub Delete_1()
Sheets(2).Range("A1:A15").Delete
End Sub
'LISTING 8.80
Sub Delete_2()
Sheets(3).DrawingObjects.Delete
End Sub
'LISTING 8.81
Sub Offset_1()
Sheets(3).Range("C3").Offset(3, 5).Value = "Trzy"
End Sub
'LISTING 8.82
Sub Display_2()
Static Blokada As Boolean
If Blokada = True Then
Blokada = False
Else
Blokada = True
End If
'Edycja danych bezpośrednio w komórce
Application.EditDirectlyInCell = Blokada
'Przesunięcie kursora w dół po wciśnięciu Enter
Application.MoveAfterReturn = Blokada
'Wyświetlenie okna ostrzegawczego podczas operacji drag and drop
'(wytnij) mogącej zmienić zawartość komórki
Application.AlertBeforeOverwriting = Blokada
'Wyświetlenie w komórkach wartości zerowych
ActiveWindow.DisplayZeros = Blokada
'Wyświetlenie w komórkach wyrażeń
ActiveWindow.DisplayFormulas = Blokada
End Sub
'LISTING 8.83
Sub CellDragAndDrop_1()
Static Mysz As Boolean
If Mysz = True Then
Mysz = False
Else
Mysz = True
End If
Application.CellDragAndDrop = Mysz
End Sub
'LISTING 8.84
Sub Protect_1()
Static Chroń As Boolean
If Chroń = True Then
Chroń = False
Else
Chroń = True
End If
ActiveSheet.Protect DrawingObjects:=Chroń, _
Contents:=Chroń, Scenarios:=Chroń
End Sub
'LISTING 8.85
Sub Display_1()
Dim a As Byte
Dim b As Boolean
a = InputBox( _
Title:="Sterowanie interfejsem", _
prompt:="Ukrycie elementów: 1, Odkrycie elementów: 2", _
Default:=1)
If a = 1 Then b = True
If a = 2 Then b = False
'Pasek formuły
Application.DisplayFormulaBar = b
'Paski przewijania
Application.DisplayScrollBars = b
'Pasek stanu
Application.DisplayStatusBar = b
'Nagłówki wierszy i kolumn
ActiveWindow.DisplayHeadings = b
'Linie siatki
ActiveWindow.DisplayGridlines = b
'Poziomy pasek przewijania
ActiveWindow.DisplayHorizontalScrollBar = b
'Pionowy pasek przewijania
ActiveWindow.DisplayVerticalScrollBar = b
'Belka pakietu arkuszy
ActiveWindow.DisplayWorkbookTabs = b
End Sub
'LISTING 8.86
Sub Screen_1()
Application.DisplayFullScreen = True
End Sub
'LISTING 8.87
Sub Largebuttons_1()
Static Przycisk As Boolean
If Przycisk = True Then
Przycisk = False
Else
Przycisk = True
End If
Application.LargeButtons = Przycisk
End Sub
'LISTING 8.88
Sub WindowState_1()
Application.WindowState = xlMinimized
End Sub
Sub WindowState_2()
ActiveWindow.WindowState = xlMinimized
End Sub
'LISTING 8.89
Sub Arrange_1()
ActiveWindow.NewWindow
Windows.Arrange ArrangeStyle:=xlVertical, ActiveWorkbook:=True, _
syncHorizontal:=True, syncVertical:=True
End Sub
'LISTING 8.90
Sub Split_1()
Dim a As Byte
Dim b As Byte
a = InputBox( _
Title:="Podział okna", _
prompt:="Podaj ilość kolumn", _
Default:=0)
b = InputBox( _
Title:="Podział okna", _
prompt:="Podaj ilość wierszy", _
Default:=0)
ActiveWindow.SplitColumn = a
ActiveWindow.SplitRow = b
End Sub
'LISTING 8.91
Sub FreezePanes_1()
Static Zamrożenie As Boolean
If Zamrożenie = True Then
Zamrożenie = False
Else
Zamrożenie = True
End If
ActiveCell.Select
ActiveWindow.FreezePanes = Zamrożenie
End Sub
'LISTING 8.92
Sub LargeScroll_1()
Windows(1).LargeScroll _
down:=1, _
toRight:=1
End Sub
'LISTING 8.93
Sub Powrót()
Range("A1").Select
End Sub
'LISTING 8.94
Sub Activate_1()
Worksheets(2).Activate
End Sub
Sub Activate_2()
Worksheets(1).Activate
End Sub
'LISTING 8.95
Sub Add_1()
Dim a As Byte
a = InputBox( _
Title:="Wstawienie arkusza", _
prompt:="Podaj nr arkusza, przed którym zostanie wstawiony nowy" & _
"arkusz.", _
Default:=1)
Worksheets(a).Select
Worksheets.Add
End Sub
'LISTING 8.96
Sub Ustawienie_strony()
Dim a As Byte
Dim a1 As Byte
Dim b As String
Dim c As Boolean
Dim d As Single
With ActiveSheet.PageSetup
a = InputBox( _
Title:="Orientacja strony.", _
prompt:="Pionowa - 1, Pozioma - 2", _
Default:=1)
If a = 1 Then .Orientation = xlPortrait
If a = 2 Then .Orientation = xlLandscape
d = InputBox( _
Title:="Ustawienie lewego marginesu", _
prompt:="Podaj szerokość lewego marginesu (w cm): ", _
Default:=2.5)
.LeftMargin = Application.InchesToPoints(d * 0.393700787401575)
d = InputBox( _
Title:="Ustawienie prawego marginesu (w cm): ", _
prompt:="Podaj szerokość prawego marginesu: ", _
Default:=2.5)
.RightMargin = Application.InchesToPoints(d * 0.393700787401575)
d = InputBox( _
Title:="Ustawienie górnego marginesu (w cm): ", _
prompt:="Podaj wysokość górnego marginesu: ", _
Default:=2.5)
.TopMargin = Application.InchesToPoints(d * 0.393700787401575)
d = InputBox( _
Title:="Ustawienie dolnego marginesu (w cm): ", _
prompt:="Podaj wysokość dolnego marginesu: ", _
Default:=2.5)
.BottomMargin = Application.InchesToPoints(d * 0.393700787401575)
d = InputBox( _
Title:="Ustawienie marginesu nagłówka (w cm): ", _
prompt:="Podaj wysokość marginesu nagłówka: ", _
Default:=1.3)
.HeaderMargin = Application.InchesToPoints(d * 0.393700787401575)
d = InputBox( _
Title:="Ustawienie marginesu stopki (w cm): ", _
prompt:="Podaj wysokość marginesu stopki: ", _
Default:=1.3)
.FooterMargin = Application.InchesToPoints(d * 0.393700787401575)
b = InputBox( _
Title:="Nagłówek - lewa część strony", _
prompt:="Wprowadź treść nagłówka: (&P-strona, &N-strony" & _
"&D-data, &T- czas, &F- skoroszyt, &A-arkusz): ", _
Default:="")
.LeftHeader = b
b = InputBox( _
Title:="Nagłówek - środek strony", _
prompt:="Wprowadź treść nagłówka: (&P-strona, &N-strony," & _
"&D-data, &T- czas, &F-skoroszyt, &A-arkusz): ", _
Default:="")
.CenterHeader = b
b = InputBox( _
Title:="Nagłówek - prawa część strony", _
prompt:="Wprowadź treść nagłówka: (&P-strona, &N-strony," & _
"&D-data, &T- czas, &F-skoroszyt, &A-arkusz): ", _
Default:="")
.RightHeader = b
b = InputBox( _
Title:="Stopka - lewa część strony", _
prompt:="Wprowadź treść stopki: (&P-strona, &N-strony," & _
"&D-data, &T- czas, &F-skoroszyt, &A-arkusz): ", _
Default:="")
.LeftFooter = b
b = InputBox( _
Title:="Stopka - środek strony", _
prompt:="Wprowadź treść stopki: (&P-strona, &N-strony," & _
"&D-data, &T- czas, &F-skoroszyt, &A-arkusz): ", _
Default:="")
.CenterFooter = b
b = InputBox( _
Title:="Stopka - prawa część strony", _
prompt:="Wprowadź treść stopki: (&P-strona, &N-strony," & _
"&D-data, &T- czas, &F-skoroszyt, &A-arkusz): ", _
Default:="")
.RightFooter = b
a = InputBox( _
Title:="Numeracja pierwszej strony", _
prompt:="Podaj numer pierwszej strony: ", _
Default:=1)
.FirstPageNumber = a
a = InputBox( _
Title:="Format papieru", _
prompt:="Podaj format papieru (1-A4, 2-A5): ", _
Default:=1)
If a = 1 Then .PaperSize = xlPaperA4
If a = 2 Then .PaperSize = xlPaperA5
a = InputBox( _
Title:="Powtarzaj wiersze: ", _
prompt:="Bez powtórzeń - 0, Jeden wiersz - 1," & _
"Dwa wiersze - 2, Trzy wiersze - 3", _
Default:=0)
If a = 0 Then .PrintTitleRows = ""
If a = 1 Then .PrintTitleRows = "$1: $1"
If a = 2 Then .PrintTitleRows = "$1: $2"
If a = 3 Then .PrintTitleRows = "$1: $3"
a = InputBox( _
Title:="Powtarzaj kolumny: ", _
prompt:="Bez powtórzeń - 0, Jedna kolumna - 1," & _
"Dwie kolumny - 2, Trzy kolumny - 3", _
Default:=0)
If a = 0 Then .PrintTitleColumns = ""
If a = 1 Then .PrintTitleColumns = "$A: $A"
If a = 2 Then .PrintTitleColumns = "$A: $B"
If a = 3 Then .PrintTitleColumns = "$A: $C"
'W przypadku ustawienia obszaru wydruku należy podać
'jego zakres, np. PrintArea = "B2: K25"
ActiveSheet.PageSetup.PrintArea = ""
c = InputBox( _
Title:="Nagłówki kolumn i wierszy", _
prompt:="Brak - 0, Widoczne - 1.", _
Default:=0)
.PrintHeadings = c
c = InputBox( _
Title:="Wydruk linii siatki", _
prompt:="Nie - 0, Tak - 1.", _
Default:=0)
.PrintGridlines = c
a = InputBox( _
Title:="Wydruk komentarzy", _
prompt:="Brak - 0, Na końcu arkusza - 1," & _
"Tak jak w arkuszu - 2.", _
Default:=0)
If a = 0 Then .PrintComments = xlPrintNoComments
If a = 1 Then .PrintComments = xlPrintSheetEnd
If a = 2 Then .PrintComments = xlPrintInPlace
a = InputBox( _
Title:="Jakość wydruku", _
prompt:="Duża - 4, Średnia - 3, Mała - 2," & _
"Jakość robocza - 1.", _
Default:=3)
.PrintQuality = -a
c = InputBox( _
Title:="Wyśrodkowanie w poziomie", _
prompt:="Nie - 0, Tak - 1.", _
Default:=0)
.CenterHorizontally = c
c = InputBox( _
Title:="Wyśrodkowanie w pionie", _
prompt:="Nie - 0, Tak - 1.", _
Default:=0)
.CenterVertically = c
c = InputBox( _
Title:="Jakość robocza", _
prompt:="Nie - 0, Tak - 1.", _
Default:=0)
.Draft = c
c = InputBox( _
Title:="Wydruk czarno - biały", _
prompt:="Nie - 0, Tak - 1.", _
Default:=0)
.BlackAndWhite = c
d = InputBox( _
Title:="Dopasowanie w procentach do rzeczywistej wielkości", _
prompt:="Podaj wielkość dopasowania: ", _
Default:=100)
.Zoom = d
a = InputBox( _
Title:="Wpasowanie w strony poziomo", _
prompt:="Podaj ilość stron: ", _
Default:=1)
.FitToPagesWide = a
a1 = InputBox( _
Title:="Wpasowanie w strony pionowo", _
prompt:="Podaj ilość stron: ", _
Default:=1)
.FitToPagesTall = a1
If a > 1 Or a1 > 1 Then .Zoom = False
a = InputBox( _
Title:="Kolejność drukowania", _
prompt:="Najpierw poziomo, potem pionowo - 1," & _
"Najpierw pionowo, potem poziomo 2.", _
Default:=1)
If a = 1 Then .Order = xlDownThenOver
If a = 2 Then .Order = xlOverThenDown
End With
End Sub
'LISTING 8.97
Sub Błąd_1()
Dim a, b, c As Variant
a = InputBox("Podaj wartość a: ")
b = InputBox("Podaj wartość b: ")
c = a / b
End Sub
'LISTING 8.98
Sub Błąd_1()
Dim a, b, c As Variant
On Error GoTo błąd
a = InputBox("Podaj wartość a: ")
b = InputBox("Podaj wartość b: ")
c = a / b
błąd:
MsgBox "Dzielenie przez zero! "
End Sub
'LISTING 8.99
Sub Błąd_2()
Dim a, b, c As Byte
On Error GoTo błąd
a = InputBox("Podaj wartość a: ")
b = InputBox("Podaj wartość b: ")
c = a / b
MsgBox c
Exit Sub
błąd:
MsgBox "Dzielenie przez zero! "
b = 1
Resume
End Sub
'LISTING 8.100
Sub Błąd_3()
Dim a, b, c As Byte
On Error GoTo błąd
a = InputBox("Podaj wartość a: ")
b = InputBox("Podaj wartość b: ")
c = a / b
c = a - (-b)
MsgBox c
Exit Sub
błąd:
MsgBox "Dzielenie przez zero! "
Resume Next
End Sub
'LISTING 8.101
Sub Błąd_4()
Dim a, b, c As Byte
On Error GoTo błąd
a = InputBox("Podaj wartość a: ")
podaj_b:
b = InputBox("Podaj wartość b: ")
If b = 0 Then Err.Raise 1111, , "Wprowadź liczbę różną od zera! "
c = a / b
MsgBox c
Exit Sub
błąd:
If Err = 1111 Then
MsgBox (Err.Description)
Resume podaj_b
End If
End Sub
'LISTING 8.102
Sub Błąd_5()
Dim a, b As Byte
On Error GoTo błąd
a = InputBox("Podaj wartość a: ")
b = Sqr(a)
MsgBox c
Exit Sub
błąd:
MsgBox "Nr błędu " & Err.Number & Chr$(13) & "Opis błędu: " & _
Err.Description
End Sub
'LISTING 8.103
Sub Test()
Dim a, b, c As Variant
a = InputBox("Podaj wartość a: ")
b = InputBox("Podaj wartość b: ")
a = a / 2
b = b + 10
c = a + b
a = c - b
b = b * a
c = a * b
End Sub
Wyszukiwarka
Podobne podstrony:
ROZDZ8B (2)ROZDZ8D (2)ROZDZ8rozdz8ROZDZ8CROZDZ8Afotogrametria rozdz8 pojęciaROZDZ8więcej podobnych podstron