Упражнение Редактор на vba. Прозорци Properties, Code, Immediate. Програми с линейна структура

Изтегляне 183.01 Kb.

Дата	07.01.2017
Размер	183.01 Kb.
	#12168

Функции MsgBox и InputBox. Откриване и коригиране на грешки. Типове данни, константи, променливи, операции (аритметични и др.)
Упражнение 6. Програми с разклонена структура. Варианти на оператора If. Оператор Select Case. Оператор за безусловен преход Goto. Етикети.
S=a+b (+ ; – ; * ; /
Упражнение 7. Програми с циклична структура. Оператори For-Next и Do-Loop. Изчисляване на суми, произведения, факториели. Работа с масиви – въведение.
Упражнение 8. Едномерни масиви. Задачи за намиране на минимум и максимум в едномерен масив, елементи в интервал, сума и произведение. Сортиране на едномерен масив.
Упражнение 9, 10. Двумерни масиви. Задачи с матрици. Суми, произведения, минимум, максимум, работа с елементи под / над главен / второстепенен диагонал.
Упражнение 11. Работа с текстови файлове. Оператори Open, Close , Input , Print . Функция EOF.
Упражнение 12. Подпрограми. Деклариране и извикване на процедури Sub и Function.

Упражнение 5.

Редактор на VBA. Прозорци Properties, Code, Immediate. Програми с линейна структура.

Типове данни, константи, променливи. Изрази и операции (аритметични, релационни, логически). Оператор за присвояване. Вградени функции.

Функции MsgBox и InputBox. Откриване и коригиране на грешки.

Типове данни, константи, променливи, операции (аритметични и др.)
Option Explicit

==================================================

Sub Program1()

' Първа програма - сума на две реални числа

Dim a As Single, b As Single, S As Single

a = InputBox("a=")

b = InputBox("b=")

S = a + b

MsgBox ("S=" & S)

End Sub

==================================================
Sub Program2()

' Втора програма - водна смес

Dim V1 As Single, T1 As Single, V2 As Single, T2 As Single

Dim V As Single, T As Single

V1 = InputBox("V1=")

T1 = InputBox("T1=")

V2 = InputBox("V2=")

T2 = InputBox("T2=")

V = V1 + V2

T = (V1 * T1 + V2 * T2) / V

MsgBox ("V=" & V)

MsgBox ("T=" & T)

End Sub

==================================================

Sub Program3()

' Определете разстоянието между две точки в пространството

Dim x1 As Single, y1 As Single, z1 As Single

Dim x2 As Single, y2 As Single, z2 As Single

Dim d As Single

x1 = InputBox("x1=")

y1 = InputBox("y1=")

z1 = InputBox("z1=")

x2 = InputBox("x2=")

y2 = InputBox("y2=")

z2 = InputBox("z2=")

d = SQR((x2-x1)^2 + (y2-y1)^2 + (z2-z1)^2)

MsgBox ("distance=" & d)

End Sub

==================================================
Sub Program4()

' Определете обиколката и лицето на триъгълник в равнината

Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single

Dim a As Single, b As Single, c As Single, p As Single, S As Single

x1 = InputBox("x1=")

y1 = InputBox("y1=")

x2 = InputBox("x2=")

y2 = InputBox("y2=")

x3 = InputBox("x3=")

y3 = InputBox("y3=")

a = SQR((x2-x1)^2 + (y2-y1)^2)

b = SQR((x2-x3)^2 + (y2-y3)^2)

c = SQR((x3-x1)^2 + (y3-y1)^2)

p = (a+b+c)/2

S = SQR(p*(p-a)*(p-b)*(p-c))

MsgBox ("P=" & 2*p & " S=" & S)

End Sub

==================================================

Упражнение 6.

Програми с разклонена структура. Варианти на оператора If.

Оператор Select Case. Оператор за безусловен преход Goto. Етикети.
Sub Prog_If1()

' функция при различни условия

Dim x As Single, y As Single

x = InputBox("x=")

If x > 0 Then

y = Sqr(x)

Else

y = x ^ 2

End If

MsgBox ("y=" & y)

End Sub

==================================================

Sub Prog_If2()

' функция при различни условия – за самостоятелна работа

Dim x As Single, a As Single, y As Single

x = InputBox("x=")

a = InputBox("a=")
If x > a Then

y = (x^2+1) / 2

Else

y = (x^4+1) / 4

End If

MsgBox ("y=" & y)

End Sub

==================================================

Sub Prog_If3()

' решаване на квадратно уравнение

Dim a As Double, b As Double, c As Double, d As Double

Dim x1 As Single, x2 As Single

et1: a = InputBox("a=")

If a <> 0 Then

b = InputBox("b=")

c = InputBox("c=")

d = b ^ 2 - 4 * a * c

If d > 0 Then

x1 = (-b + Sqr(d)) / (2 * a)

x2 = (-b - Sqr(d)) / 2 / a

MsgBox ("x1=" & x1 & " x2=" & x2)

Else

If d = 0 Then

x1 = -b / (2 * a)

x2 = x1

MsgBox ("x1=x2=" & x1)

Else

MsgBox ("Няма реални корени.")

End If

Else

MsgBox ("Това не е квадратно уравнение.")

GoTo et1

End If

End Sub

==================================================

Sub Prog_Select1()

' Пета програма – калкулатор: S=a+b (+ ; – ; * ; / )

Dim a As Single, b As Single, S As Single

Dim c As String

a = InputBox("a=")

b = InputBox("b=")

et1: c = InputBox("Операция=")

Select Case c

Case "+"

S = a + b

Case "-"

S = a - b

Case "*"

S = a * b

Case "/"

S = a / b

Case Else

MsgBox ("Грешка!")

GoTo et1

End Select

MsgBox ("S=" & a & c & b & "=" & S)

End Sub

==================================================
Sub Prog_Select2 ()

' Шеста програма - Дни от седмицата

Dim Day As Integer

Dim Txt As String

et1: Day = InputBox("Въведи число от 1 до 7:")

Select Case Day

Case 1

Txt = "Понеделник"

Case 2

Txt = "Вторник"

Case 3

Txt = "Сряда"

Case 4

Txt = "Четвъртък"

Case 5

Txt = "Петък"

Case 6

Txt = "Събота"

Case 7

Txt = "Неделя"

Case Else

MsgBox ("Грешка!")

GoTo et1

End Select

Select Case Day

Case 1 To 5

Txt = Txt + " е работен ден."

Case 6 To 7

Txt = Txt + " е почивен ден."

End Select

MsgBox (Txt)

End Sub

Упражнение 7.

Програми с циклична структура. Оператори For-Next и Do-Loop.

Изчисляване на суми, произведения, факториели. Работа с масиви – въведение.

Задача: ;

Option Explicit

Sub Suma()

Dim i%, M%, N%, S%
M = InputBox("M=")

N = InputBox("N=")

S=0

For i = M To N

S = S + i

Next i

MsgBox("Sum = " & S)

End Sub

' После студентите да променят програмата, така че тя да изчислява:

==================================================

Sub Product()

Dim i%, M%, P%
M = InputBox("M=")
P=1

For i = 1 To M

P = P * i

Next i

MsgBox(M & "! = " & P)

End Sub
' После студентите да променят програмата, така че тя да изчислява:

Упражнение 8.

Едномерни масиви. Задачи за намиране на минимум и максимум в едномерен масив, елементи в интервал, сума и произведение. Сортиране на едномерен масив.

;

; x_i≠0

Даден е едномерен масив A(M) с елементи от тип double. Eлементите са записани в първия ред на Sheet1.

а) да се намери сумата от всички елементи;

б) да се намери произведението от всички ненулеви елементи;

в) да се намери средното аритметично на всички положителни елементи;

г) да се намери най-големият елемент в масива и неговия индекс;

д) да се намери най-малкият елемент в масива и неговия индекс;

е) сортирайте и изведете елементите във възходящ ред

ж) скаларното произведение на елементите от първия и втория ред в Sheet1
Option Explicit

Sub Array1()

' Работа с едномерен масив

Dim i%, M%

Dim A() As Double
M = InputBox("M=")

ReDim A(1 To M)

For i = 1 To M

A(i) = ActiveSheet.Cells(1, i) ' данните са в първия ред на Sheet1

Next i
' a) сума на всички елементи в масива
Dim S As Double

S = 0

For i = 1 To M

S = S + A(i)

Next i

MsgBox ("Сума S=" & S)

' б) произведение на всички ненулеви елементи в масива
Dim P As Double

P = 1

For i = 1 To M

If A(i) <> 0 Then P = P * A(i)

Next i

MsgBox ("Произведение P=" & P)

' в) средно аритметично на всички положителни елементи в масива
Dim Sp As Double, Np As Integer

Sp = 0: Np = 0

For i = 1 To M

If A(i) > 0 Then Sp = Sp + A(i): Np = Np + 1

Next i
If Np > 0 Then

MsgBox ("Средно аритметично: " & Sp / Np)

Else

MsgBox ("Няма положителни елементи")

End If

' г) максимум на елементите в масива

Dim Max As Double, imax As Integer

Max = A(1): imax = 1

For i = 2 To M

If A(i) > Max Then Max = A(i): imax = i

Next i

MsgBox ("Максимум Max = A(" & imax & ")= " & Max)

' д) минимум на елементите в масива
Dim Min As Double, imin As Integer

Min = A(1): imin = 1

For i = 2 To M

If A(i) < Min Then Min = A(i): imin = i

Next i

MsgBox ("Минимум Min = A(" & imin & ")= " & Min)

' е) сортиране на елементите на масива във възходящ ред,

' подредените елементи да се изведат на втория ред

Dim T As Double, j As Integer
For i = 1 To M - 1

For j = 1 To M - i

If A(j) > A(j + 1) Then

T = A(j): A(j) = A(j + 1): A(j + 1) = T

End If

Next j

Next i
For i = 1 To M

ActiveSheet.Cells(2, i) = A(i)

Next
' ж) скаларно произведение на елементите от първия и втория ред
Dim SkP As Double, j As Integer
SkP = 0

For i = 1 To M

SkP = SkP + ActiveSheet.Cells(1, i) * ActiveSheet.Cells(2, i)

Next i
MsgBox ("Скаларно произведение= " & SkP)

End Sub

==================================================

Sub Skalar()

' Скаларно произведение на два вектора

Dim i%, M%

Dim a() As Double, b() As Double, S As Double

M = InputBox("M=")

ReDim a(1 To M), b(1 To M)

For i = 1 To M

a(i) = ActiveSheet.Cells(1, i)

b(i) = ActiveSheet.Cells(2, i)

Next i
S = 0

For i = 1 To M

S = S + a(i) * b(i)

Next i
MsgBox ("Скаларно произведение S=" & S)

End Sub

==================================================

Задача с точки: Дадени са X и Y-координатите на M точки в равнината. Всеки 3 последователни точки образуват триъгълник. Намерете номера на триъгълника с най-голям периметър.

Sub Points()

Dim i%, M%, a#, b#, c#, imax%

Dim X() As Double, Y() As Double, P() As Double, PMax#
M = InputBox("M=")

ReDim X(1 To M), Y(1 To M), P(1 To M)

For i = 1 To M

X(i) = ActiveSheet.Cells(1, i)

Y(i) = ActiveSheet.Cells(2, i)

Next i
For i = 1 To M - 2

a = Sqr((X(i) - X(i + 1)) ^ 2 + (Y(i) - Y(i + 1)) ^ 2)

b = Sqr((X(i + 1) - X(i + 2)) ^ 2 + (Y(i + 1) - Y(i + 2)) ^ 2)

c = Sqr((X(i) - X(i + 2)) ^ 2 + (Y(i) - Y(i + 2)) ^ 2)

P(i) = a + b + c

Next i
PMax = P(1): imax = 1

For i = 2 To M - 2

If PMax < P(i) Then PMax = P(i): imax = i

Next
MsgBox ("Максимален периметър Max = P(" & imax & ")= " & PMax)

End Sub

Упражнение 9, 10.

Двумерни масиви. Задачи с матрици. Суми, произведения, минимум, максимум, работа с елементи под / над главен / второстепенен диагонал.
Дадена е матрица Z(M,N) с максимум 8 реда и 8 стълба, съставена от елементи от тип Double. Записана е в Sheet1. Да се намерят:

а) сумата на всички елементи;

б) произведението на всички ненулеви елементи в матрицата;

в) максимума на матрицата и местоположението му (ред и стълб);

г) минимума на матрицата и местоположението му (ред и стълб);

д) средното аритметично на положителните елементи над главния диагонал, ако матрицата е квадратна (M=N);

е) максимума под второстепенния диагонал, ако матрицата е квадратна;

ж) сумите по редове на матрицата;

з) минимумите по стълбове на матрицата;

и) да се копират всички отрицателни елементи в едномерния масив D и да се подредят във възходящ ред. Да се изведат трите най-малки от тях.

Option Explicit
' Процедура за работа с матрица

Sub Matrix()

Dim Z() As Double

Dim M As Integer, N As Integer

Dim i As Integer, j As Integer

' зареждане на данни от Excel -> Sheet1

Dim W As Worksheet

Set W = Application.Worksheets("Sheet1") ' така може да се избират различни страници

W.Activate

M=InputBox("M=")

Loop Until M>1 and M<=8

N=InputBox("N=")

Loop Until N>1 and N<=8
ReDim Z(1 To M, 1 To N)

For i = 1 To M

For j = 1 To N

Z(i, j) = W.Cells(i, j)

' а) сума на всички елементи в матрицата

Dim S As Double

S = 0

For i = 1 To M

For j = 1 To N

S = S + Z(i, j)

MsgBox ("S=" & S)

' б) произведение на всички ненулеви елементи в матрицата

Dim P As Double

P = 1

For i = 1 To M

For j = 1 To N

If Z(i, j) <> 0 Then P = P * Z(i, j)

MsgBox ("P=" & P)

' в) максимум на матрицата и местоположението му (ред и стълб)

Dim Max As Double

Dim imax As Integer, jmax As Integer

Max = Z(1, 1)

imax = 1: jmax = 1

For i = 1 To M

For j = 1 To N

If Z(i, j) > Max Then Max = Z(i, j): imax = i: jmax = j

MsgBox ("Max=Z(" & imax & "," & jmax & ")=" & Max)

' г) минимум на матрицата и местоположението му (ред и стълб)

Dim Min As Double

Dim imin As Integer, jmin As Integer

Min = Z(1, 1)

imin = 1: jmin = 1

For i = 1 To M

For j = 1 To N

If Z(i, j) < Min Then Min = Z(i, j): imin = i: jmin = j

MsgBox ("Min=Z(" & imin & "," & jmin & ")=" & Min)

' д) средно аритметично на положителните елементи над главния диагонал, ако матрицата е квадратна

If M = N Then

Dim Sp As Double, Ap As Double

Dim Np As Integer

Sp = 0: Np = 0

For i = 1 To M

For j = 1 To N

If i < j Then

If Z(i, j) > 0 Then Sp = Sp + Z(i, j): Np = Np + 1

End If

If Np > 0 Then

Ap = Sp / Np

MsgBox ("Ap=" & Ap)

Else

MsgBox ("Няма положителни елементи")

End If

' е) максимум под второстепенния диагонал, ако матрицата е квадратна

If M = N Then

Dim Max2 As Double

Max2 = Z(M, N)

For i = 1 To M

For j = 1 To N

If i + j > N + 1 Then

If Z(i, j) > Max2 Then Max2 = Z(i, j)

End If

MsgBox ("Max2=" & Max2)

End If

' ж) суми по редове на матрицата

Dim SR() As Double

ReDim SR(1 To M)

For i = 1 To M

SR(i) = 0

For j = 1 To N

SR(i) = SR(i) + Z(i, j)

MsgBox ("SR(" & i & ")=" & SR(i))

' з) минимуми по стълбове на матрицата

Dim MinK() As Double

ReDim MinK(1 To N)

For j = 1 To N

MinK(j) = Z(1, j)

For i = 2 To M

If Z(i, j) < MinK(j) Then MinK(j) = Z(i, j)

MsgBox ("MinK(" & j & ")=" & MinK(j))

' и) да се изведат 3те най-малки отрицателни елементи в матрицата, като се използва помощен едномерен масив D

Dim D() As Double

ReDim D(1 To M * N)

Dim L As Integer

L = 0

For i = 1 To M

For j = 1 To N

If Z(i, j) < 0 Then L = L+1: D(L) = Z(i, j)

Next
' сортиране на масива D във възходящ ред

Dim C As Double

For i = 1 To L - 1

For j = 1 To L - i

If D(j) < D(j + 1) Then C = D(j + 1): D(j + 1) = D(j): D(j) = C

Next
' извеждане на трите най-малки елементи на масива D

If L >= 3 Then

For i = 1 To 3

MsgBox ("D(" & i & ")=" & D(i))

End If

End Sub

Упражнение 11.

Работа с текстови файлове. Оператори Open, Close #, Input #, Print #. Функция EOF.

Option Explicit

Sub ReadArr()

' Чете едномерен масив от файл

Dim i#, n#, Sum#

Open "f:\piis\draka\test.txt" For Input As #1

i = 0

Sum = 0

Do While Not EOF(1) ' Проверява дали сме стигнали края на файла

Input #1, n

ActiveCell.Offset(i, 0) = i + 1

ActiveCell.Offset(i, 1) = n

' Извежда номер на елемент и самия елемент надолу и надясно от текущата позиция

i = i + 1

Sum = Sum + n

Loop

Close #1

ActiveCell.Offset(i, 0) = "sum"

ActiveCell.Offset(i, 1) = Sum

End Sub
Съдържание на файла test.txt:

100

105

110

115

120

125
Sub ReadMatrix()

' Четене на матрица от файл

Dim i%, j%, m%, n%

Dim X() As Double

Dim Fname As String

Fname = InputBox("filename:")

'Fname = "f:\piis\draka\matr.txt"

Open Fname For Input As #1

Input #1, m, n

ReDim X(1 To m, 1 To n)

For i = 1 To m

For j = 1 To n

Input #1, X(i, j)

ActiveSheet.Cells(i, j) = X(i, j)

Next j

Next i

Close #1

' Изчислява минимуми, максимуми и суми по редове

Dim SumR() As Double, MinR() As Double, MaxR() As Double

ReDim SumR(1 To m), MinR(1 To m), MaxR(1 To m)

For i = 1 To m

SumR(i) = 0

MaxR(i) = X(i, 1)

MinR(i) = X(i, 1)

For j = 1 To n

SumR(i) = SumR(i) + X(i, j)

If MaxR(i) < X(i, j) Then MaxR(i) = X(i, j)

If MinR(i) > X(i, j) Then MinR(i) = X(i, j)

Next j

ActiveSheet.Cells(i, n + 1) = SumR(i)

ActiveSheet.Cells(i, n + 2) = MaxR(i)

ActiveSheet.Cells(i, n + 3) = MinR(i)

Next i

' Изчислява минимуми, максимуми и суми по стълбове

Dim SumC() As Double, MinC() As Double, MaxC() As Double

ReDim SumC(1 To n), MinC(1 To n), MaxC(1 To n)

For j = 1 To n

SumC(j) = 0

MaxC(j) = X(1, j)

MinC(j) = X(1, j)

For i = 1 To m

SumC(j) = SumC(j) + X(i, j)

If MaxC(j) < X(i, j) Then MaxC(j) = X(i, j)

If MinC(j) > X(i, j) Then MinC(j) = X(i, j)

Next i

ActiveSheet.Cells(m + 1, j) = SumC(j)

ActiveSheet.Cells(m + 2, j) = MaxC(j)

ActiveSheet.Cells(m + 3, j) = MinC(j)

Next j
Range("A1").Select

Selection.Font.Bold = True

Selection.Font.Italic = True

Range("B2:C3").Select

Selection.Font.Bold = True

Selection.Font.Italic = True

Range("F:F").Select

Selection.Font.Bold = True

Selection.Font.Italic = True

Range("5:5").Select

Selection.Font.Bold = True

Selection.Font.Italic = True

Dim RangeStr$

RangeStr = Cells(1, 1).Address & ":" & Cells(m, n).Address

Range(RangeStr$).Select

Selection.Font.Bold = False

Selection.Font.Italic = False

End Sub
Съдържание на файла matr.txt:

3 4

1 2 3 4

5 6 7 8

9 10 11 12

Упражнение 12.

Подпрограми. Деклариране и извикване на процедури Sub и Function.

Параметри и аргументи. Предаване на параметри по стойности и адрес. Излизане от процедура. Глобални и локални декларации.

Option Explicit

' Чете матрица от файл

Private Sub ReadMatrix(X, M As Integer, N As Integer)

Dim i%, j%

Dim Fname As String

Fname = InputBox("Въведете име на файла:")

'Fname = "f:\piis\draka\matr.txt"

Open Fname For Input As #1

Input #1, M, N

ReDim X(1 To M, 1 To N)

For i = 1 To M

For j = 1 To N

Input #1, X(i, j)

Next j

Next i

Close #1

End Sub

==================================================
' Показва прочетената от файла матрица в зададена страница на Ексел

Private Sub DisplayMatrix(SheetStr$, X, M As Integer, N As Integer)

Dim i%, j%

For i = 1 To M

For j = 1 To N

Worksheets(SheetStr).Cells(i, j) = X(i, j)

Next j

Next i

End Sub

==================================================

' Изчислява сумата на всички елементи в матрицата

Private Function SumMatrix(X, M As Integer, N As Integer) As Double

Dim i%, j%, S As Double

S = 0

For i = 1 To M

For j = 1 To N

S = S + X(i, j)

Next j

Next i

SumMatrix = S

End Function

==================================================

' Намира максимума от всички елементи в матрицата

Private Function MaxMatrix(X, M As Integer, N As Integer) As Double

Dim i%, j%, Max As Double

Max = X(1, 1)

For i = 1 To M

For j = 1 To N

If Max < X(i, j) Then Max = X(i, j)

Next j

Next i

MaxMatrix = Max

End Function

==================================================

' Главна процедура

Sub Main()

Dim i%, j%, M%, N%

Dim X() As Double

Call ReadMatrix(X, M, N)

Call DisplayMatrix("Sheet1", X, M, N)

Dim S As Double

S = SumMatrix(X, M, N)

MsgBox ("Sum=" & S)

Dim Max As Double

Max = MaxMatrix(X, M, N)

MsgBox ("Max=" & Max)

End Sub

Option Explicit

' Задача за работа с точки
Sub LoadPoints()

Dim i%, n%

Dim X(), Y(), L() As Double

Dim Fname As String

' Трие съдържанието на Sheet1

ClearSheet ("Sheet1")

Fname = InputBox("Въведете име на файла с данни:")

'Fname = "f:\piis\test\points.txt"

Open Fname For Input As #1

Input #1, n

ReDim X(1 To n), Y(1 To n), L(1 To n)

Cells(1, 1) = "X": Cells(1, 2) = "Y": Cells(1, 3) = "L"

For i = 1 To n

Input #1, X(i), Y(i)

'Изчислява дължината на радиус вектора от точка Oxy до всяка точка

L(i) = Dist0(X(i), Y(i))

Cells(i + 1, 1) = X(i)

Cells(i + 1, 2) = Y(i)

Cells(i + 1, 3) = L(i): Cells(i + 1, 3).NumberFormat = "0.00"

Next i

Close #1
Dim S#, R1#, R2#

'Изчислява лицето на триъгълника, образуван от първите 3 точки

S = Area(X(1), Y(1), X(2), Y(2), X(3), Y(3))

MsgBox ("Area=" & S)

R1 = Max(L, n)

MsgBox ("Max Radius-vectors=" & R1)

R2 = Min(L, n)

MsgBox ("Min Radius-vectors=" & R2)

' Оцветява в бежаво координатите на точките

Call DrawFill("Sheet1", "A2:" & Cells(1 + n, 2).Address, 255, 220, 200)

' Оцветява в различен цвят всяка дължина на отсечка

For i = 1 To n

Call DrawFill("Sheet1", Cells(1 + i, 3).Address, 128 + i * 20, 255 - i * 20, i * 20)

Next
' Изписва текста в посочената област, завъртян на 90 градуса

Call RotateText("Sheet1", "A1:C1",90)

End Sub

==================================================
Private Function Dist0(ByVal X As Double, ByVal Y As Double) As Double

'Изчислява дължината на радиус вектора от Oxy до точка (X,Y)

Dist0 = Sqr(X ^ 2 + Y ^ 2)

End Function

==================================================
Private Function Dist(ByVal x1#, ByVal y1#, ByVal x2#, ByVal y2#) As Double

'Изчислява дължината на отсечката от точка (x1,y1) до точка (x2,y2)

Dist = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)

End Function

==================================================
Private Function Area(ByVal x1#, ByVal y1#, ByVal x2#, ByVal y2#, ByVal x3#, ByVal y3#) As Double

'Изчислява лице на триъгълник по Херонова формула

'по зададени x и y координати на 3те върха

Dim a#, b#, c#, p#

a = Dist(x1, y1, x2, y2)

b = Dist(x2, y2, x3, y3)

c = Dist(x1, y1, x3, y3)

p = (a + b + c) / 2

Area = Sqr(p * (p - a) * (p - b) * (p - c))

End Function

==================================================
Private Function Max(X, n%)

'Търси максималния елемент в масива X

Dim i%

Max = X(1)

For i = 2 To n

If Max < X(i) Then Max = X(i)

Next i

End Function

==================================================
Private Function Min(X, n%)

'Търси минималния елемент в масива X

Dim i%

Min = X(1)

For i = 2 To n

If Min > X(i) Then Min = X(i)

Next i

End Function

==================================================
Private Sub DrawFill(SheetStr$, RangeStr$, R%, G%, B%)

' Оцветява в зададен цвят (R,G,B) област RangeStr$ от страница SheetStr$

Dim Data As Range

Set Data = Sheets(SheetStr).Range(RangeStr$)

With Data.Interior

.Color = RGB(R, G, B)

End With

End Sub

==================================================
Private Sub RotateText(SheetStr$, RangeStr$, AngleDeg%)

' Изписва текста, завъртян на ъгъл AngleDeg в област RangeStr$ от страница SheetStr$

Dim W As Worksheet

Set W = Application.Worksheets(SheetStr)

W.Activate
Range(RangeStr).Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = AngleDeg

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

End Sub

==================================================

Private Sub ClearSheet(SheetStr$)

' Трие съдържанието на лист SheetStr

Worksheets(SheetStr).Cells.Clear

End Sub

==================================================
Съдържание на файла points.txt:

1 1

4 1

1 5

Каталог: filebank
filebank -> Тема на дипломната работа
filebank -> Доклад на национален дарителски фонд „13 века българия
filebank -> 1 3 в е к а б ъ л г а р и я“ Утвърдил
filebank -> Доклад на национален дарителски фонд „13 века българия
filebank -> Доклад на национален дарителски фонд „13 века българия
filebank -> Зимна сесия – уч. 2015– 2016 г. Начало на изпитите 00 ч. Теоретична механика ІІ ч. Динамика
filebank -> Упражнение №1
filebank -> О т ч е т на проф. Д-р инж. Борислав маринов – декан на геодезическия факултет при уасг пред общото събрание на факултета
filebank -> Техническа механика
filebank -> Дати за поправителната сесия септември 2013 г катедра “Техническа механика”

Изтегляне 183.01 Kb.

Сподели с приятели: