VBA 1

Option Explicit
Sub Imie()
    Dim a As String
    a = InputBox("Podaj imię")
    MsgBox "Cześć " & a
End Sub
Sub PoleKoła()
' deklaracja zmiennych
    Dim r As Single, pole As Single, obwod As Single
' deklaracja stałych
    Const Pi = 3.14
' wczytanie promienia
    r = InputBox("Podaj promień:")
    pole = Pi * r ^ 2
    obwod = 2 * Pi * r
' wypisanie wyniku
    MsgBox "Promień okręgu: " & r & Chr(13) & "Pole wynosi: " & pole & Chr(13) & "Obwod wynosi: " & obwod
End Sub
Sub zadanie1()
' zamienia wartości komórek a1 i a2 miejscami
    Dim x As Variant, y As Variant
    x = [a1] ' pobranie wartości z komórki A1
    y = [a2] ' pobranie wartości z komórki A2
    [a1] = y
    [a2] = x
End Sub
Sub zadanie2()
 ' oblicza wynagrodzenie pracownika
    Dim pracownik As String, pensja As Single, podstawa As Single, premia As Single
    pracownik = InputBox("Podaj pracownika: ")
    podstawa = InputBox("Podaj podstawę wynagrodzenia: ")
    premia = InputBox("Podaj premię: ")
    pensja = podstawa * (1 + premia / 100)
    MsgBox "Pracownik: " & pracownik & Chr(13) & "Pensja: " & pensja

End Sub
Sub zadanie3()
 ' sprawdza czy użytkownik jest pełnoletni
    Dim wiek As Integer
    wiek = InputBox("Podaj swoj wiek")
    If (wiek < 18) Then
    MsgBox "Niepełnoletni"
    Else: MsgBox "Pełnoletni"
    End If
End Sub
Sub zadanie4()
 ' spradza ktora liczba spośród a b c jest największa
    Dim a As Single, b As Single, c As Single
    a = InputBox("Podaj a")
    b = InputBox("Podaj b")
    c = InputBox("Podaj c")

    If (a > b) Then
        If (a > c) Then
            MsgBox a & " jest najwieksze"
        Else
            MsgBox c & " jest najwieksze"
        End If
    Else
        If (b > c) Then
            MsgBox b & " jest najwieksze"
        Else
            MsgBox c & " jest najwieksze"
        End If
    End If
End Sub
Sub zadanie5()
 ' spradza ktora liczba spośród a b c jest największa
    Dim a As Single, b As Single, c As Single
    Dim max As Single
    a = InputBox("Podaj a")
    b = InputBox("Podaj b")
    c = InputBox("Podaj c")
    max = a
    If (b > max) Then
    max = b
    End If
    If (c > max) Then
    max = c
    End If
    MsgBox "Największą liczbą jest " & max
End Sub
Sub zadanie6()
 ' rozwiazuje rownianie kwadratowe
    Dim a As Integer, b As Integer, c As Integer, d As Integer, p As Single, x1 As Single, x2 As Single, Re As Single, Im As Single
    a = InputBox("Podaj a")
    b = InputBox("Podaj b")
    c = InputBox("Podaj c")
    MsgBox a & " x^2 + " & b & " x + " & c & " = 0 ", , "Równanie"
    d = b * b - 4 * a * c
    MsgBox "Delta równa: " & d, vbInformation, "Delta"
    If d > 0 Then
        p = Sqr(d)
        x1 = (-b - p) / (2 * a)
        x2 = (-b + p) / (2 * a)
        MsgBox "x1 = " & x1 & Chr(13) & "x2 = " & x2, , "Rozwiązanie równania"
    End If
    If d = 0 Then
        x1 = -b / (2 * a)
        MsgBox "x0 = " & x1, , "Rozwiązanie równiania"
    End If
    If d < 0 Then
        MsgBox "Pierwiastki zespolone", vbExclamation, "Rozwiązanie równania"
        p = Sqr(-d)
        Re = -b / (2 * a)
        Im = p / (2 * a) ' znak częsci urojonej jest ustalany przy wypisywaniu wyniku
        MsgBox "x1 = " & Re & " - " & Im & " i " & Chr(13) & "x2 = " & Re & " + " & Im & " i ", , "Rozwiązanie równania dla liczb zespolonych"
    End If
End Sub
Sub zadanie7()
' sprawdza czy istnieje trójkąt prostokątny o bokach a, b, c
' nie wiemy który bok jest najdłuższy
    Dim a As Single, b As Single, c As Single
    a = InputBox("Podaj a")
    b = InputBox("Podaj b")
    c = InputBox("Podaj c")
    ' z nierówności trójkąta czy jest możliwe
    If (a < (b + c)) And (b < (a + c)) And (c < a + b) Then
        MsgBox "Istnieje trojkąt o bokach podanej długości", vbInformation, "Trójkąt ABC istnieje"
    ' z tw. cosinusów czy jest prostokątny (cos90=0)
        If (a * a = b * b + c * c) Or (b * b = a * a + c * c) Or (c * c = a * a + b * b) Then
            MsgBox "Podany trójkąt jest prostokątny", vbInformation, "Trójkąt"
        Else
            MsgBox "Podany trójkąt nie jest prostokątny", vbExclamation, "Trójkąt"
        End If
    Else
        MsgBox "Podane długości boków nie spełniają nierówności trójkąta", vbExclamation, "Trójkąt ABC nie istnieje"
    End If
End Sub
Sub dzien() 'zajęcia
Dim day As Integer
    day = InputBox("Podaj numer dnia")
    Select Case day
        Case 1 To 5
            MsgBox "Dzień roboczy", vbInformation
        Case 6 To 7
            MsgBox "Dzień wolny", vbInformation
        Case Else
            MsgBox "Podana zła wartość", vbExclamation
    End Select
End Sub
Sub zadanie8()
    Dim point As Integer
    point = InputBox("Podaj liczbę punktów: ")
    Select Case point
        Case 91 To 100
            MsgBox "Ocena: 5.0 słownie: bdb"
        Case 81 To 90
            MsgBox "Ocena: 4.5 słownie: +db"
        Case 71 To 80
            MsgBox "Ocena: 4.0 słownie: db"
        Case 61 To 70
            MsgBox "Ocena: 3.5 słownie: +dst"
        Case 51 To 60
            MsgBox "Ocena: 3.0 słownie: dst"
        Case 0 To 50
            MsgBox "Ocena: 2.0 słownie: ndst"
        Case Else
            MsgBox "Podana wartość punktów nieprawidłowa", vbExclamation
    End Select
End Sub
Sub zadanie9()
    Dim a As Single, b  As Single, c  As Single, d  As Single, p  As Single, x1  As Single, x2 As Single, Re As Single, Im As Single
    a = InputBox("Podaj a")
    b = InputBox("Podaj b")
    c = InputBox("Podaj c")
    d = b * b - 4 * a * c
    MsgBox "Delta równa: " & d
    Select Case d
        Case Is > 0
            p = Sqr(d)
            x1 = (-b - p) / (2 * a)
            x2 = (-b + p) / (2 * a)
            MsgBox "x1 = " & x1 & Chr(13) & "x2 = " & x2
        Case 0
            x1 = (-b) / (2 * a)
            MsgBox "x1 = " & x1
        Case Is < 0
            p = Sqr(-d)
        Re = -b / (2 * a)
        Im = p / (2 * a) ' znak częsci urojonej jest ustalany przy wypisywaniu wyniku
        MsgBox "x1 = " & Re & " - " & Im & " i " & Chr(13) & "x2 = " & Re & " + " & Im & " i ", , "Rozwiązanie równania dla liczb zespolonych"
    End Select
End Sub