Sub CommandButton1_Click()
Range("C2").Value = "WITAJ ŚWIECIE, WŁAŚNIE NARODZIŁ SIĘ NOWY PROGRAMISTA"
End Sub
Sub Powitanie()
MsgBox "Sajonara"
End Sub
Sub BłędnaWartość()
MsgBox "Wprowadź wartość numeryczną większą od zera"
End Sub
Private Sub CommandButton1_Click()
If Range("A1").Value = 0 Then
Range("A2").Value = "wartość wynosi zero"
Else
Range("A2").Value = "wartość jest różna od zera"
End If
End Sub
Private Sub CommandButton1_Click()
If Range("A1").Value = 0 Then
Range("A2").Value = "wartość wynosi zero"
Else
If Range("A1").Value > 0 Then
Range("A2").Value = "wartość dodatnia"
Else
Range("A2").Value = "wartość ujemna"
End If
End If
End Sub
Private Sub CommandButton1_Click()
Dim NumerDnia
NumerDnia = Range("A1").Value
If IsNumeric(NumerDnia) = True Then
Select Case NumerDnia
Case 1
Range("A2").Value = "Niedziela"
Case 2
Range("A2").Value = "Poniedziałek"
Case 3
Range("A2").Value = "Wtorek"
Case 4
Range("A2").Value = "Środa"
Case 5
Range("A2").Value = "Czwartek"
Case 6
Range("A2").Value = "Piątek"
Case 7
Range("A2").Value = "Sobota"
Case Else
Range("A2").Value = "Poza zakresem wpisz wartość od 1 do 7"
End Select
Else
Range("A2").Value = "Wpisz wartość liczbową"
End If
End Sub
Private Sub Workbook_Open()
Select Case DatePart("w", Date)
Case 1
Range("A4").Value = "Niedziela, jutro ch... poniedziałek"
Case 2
Range("A4").Value = "Dzisiaj jest poniedziałek, początek wspaniałego tygodnia "
Case 3
Range("A4").Value = "Wtorek, na szczęście to nie poniedziałek"
Case 4
Range("A4").Value = "Środa, za chwilę z górki"
Case 5
Range("A4").Value = "Czwartek, wczoraj chyba przesadziłeś, boli głowa co ?"
Case 6
Range("A4").Value = "Cudownie już piątek"
Case 7
Range("A4").Value = "Sobota, co Ci będę mówił"
End Select
End Sub
Private Sub CommandButton1_Click()
Dim NumerWiersza As Integer
Dim NumerKolumny As Integer
NumerWiersza = 1
NumerKolumny = 1
Do While Arkusz2.Cells(NumerWiersza, NumerKolumny).Value <> ""
If NumerWiersza >= 1000 Then
Exit Do
End If
NumerWiersza = NumerWiersza + 1
Loop
If NumerWiersza >= 1000 Then
MsgBox "Baza przepełniona, dane nie mogą być zapisane. Dokonaj archiwizacji"
Else
Arkusz2.Cells(NumerWiersza, NumerKolumny).Value = Arkusz1.Range("A1").Value
Arkusz2.Cells(NumerWiersza, NumerKolumny + 1).Value = Arkusz1.Range("B1").Value
Arkusz2.Cells(NumerWiersza, NumerKolumny + 2).Value = Arkusz1.Range("C1").Value
Arkusz1.Range("A1").Value = ""
Arkusz1.Range("B1").Value = ""
Arkusz1.Range("C1").Value = ""
MsgBox "Dane zostały zapisane do Arkusza2"
End If
End Sub
Sub PrzykładPętli()
Dim kolumna As Integer
For kolumna = 1 To 10
Cells(1, kolumna) = kolumna
Next kolumna
End Sub
Sub PrzykładPętli()
Dim wiersz, kolumna As Integer
Range("A1", "J1").Interior.ColorIndex = 15
Range("A2", "A10").Interior.ColorIndex = 15
For wiersz = 1 To 10
For kolumna = 1 To 10
Cells(wiersz, kolumna) = wiersz * kolumna
Next kolumna
Next wiersz
End Sub
Private Sub CommandButton1_Click()
Dim MojaLiczba As Integer
Static Licznik
MojaLiczba = Int((6 * Rnd) + 1)
Licznik = Licznik + 1
MsgBox "To jest Twoje " & Licznik & " losowanie " & "wylosowałeś " & MojaLiczba
End Sub
Private Sub CommandButton1_Click()
On Error GoTo problem
Const LiczbaPi = 3.14159265359
Dim Promień, Pole, Obwód
Promień = InputBox("Podaj promień koła")
If Promień = "" Then
MsgBox "Brak poprawnych wartości lub operacja została anulowana"
Exit Sub
Else
Pole = LiczbaPi * Promień * Promień
Obwód = 2 * LiczbaPi * Promień
MsgBox "Pole koła wynośi " & Pole & ", obwód " & Obwód
End If
Exit Sub
problem:
MsgBox "Wystąpił błąd w programie. " & Err.Description & ", wprowadź poprawne wartości "
End Sub
Function słownie(liczba)
Dim Wynik
Static jednosci(19) As String
jednosci(0) = "zero"
jednosci(1) = "jeden"
jednosci(2) = "dwa"
jednosci(3) = "trzy"
jednosci(4) = "cztery"
jednosci(5) = "pięć"
jednosci(6) = "sześć"
jednosci(7) = "siedem"
jednosci(8) = "osiem"
jednosci(9) = "dziewięć"
jednosci(10) = "dziesięć"
jednosci(11) = "jedenaście"
jednosci(12) = "dwanaście"
jednosci(13) = "trzynaście"
jednosci(14) = "czternaście"
jednosci(15) = "piętnaście"
jednosci(16) = "szesnaście"
jednosci(17) = "siedemnaście"
jednosci(18) = "osiemnaście"
jednosci(19) = "dziewiętnaście"
If IsNumeric(liczba) = False Then
Wynik = "zły typ danych - funkcja konwertuje poprawnie liczby całkowite z przedziału od 0 do 19"
słownie = Wynik
Exit Function
End If 'Za pomocą instrukcji If...Then...Else sprawdzamy czy wartość argumentu liczba naszej funkcji jest liczbą. Czyli jeżeli argument liczba nie jest liczbą wyświetlany jest komunikat o złym typie danych i kończymy działanie naszej funkcji.
If liczba > 19 Or liczba < 0 Then
Wynik = "Zły zakres - funkcja konwertuje poprawnie liczby całkowite z przedziału od 0 do 19 "
słownie = Wynik
Exit Function
End If 'Opis analogicznie jak wyżej, sprawdzamy czy argument liczba jest liczbą która mieści się w przedziale od 0 do 19.
liczba = Int(liczba)
Wynik = jednosci(liczba)
słownie = Wynik
End Function
Private Sub CommandButton1_Click()
Dim Wynik
Wynik = 10 Mod 3 ' Wynikiem jest 1
MsgBox Wynik
End Sub
Private Sub Workbook_Open()
Dim imię
imię = InputBox("Podaj swoje imię")
MsgBox "Witaj " & imię & ", miłej zabawy"
End Sub
Private Sub CommandButton1_Click()
On Error GoTo problem
Dim Warunek As Boolean
Dim Dzielna, Dzielnik, Iloraz
Dzielna = Range("B2").Value
Dzielnik = Range("D2").Value
Warunek = Dzielnik <> 0 'Nasza instrukcja przypisania.
If Warunek = True Then
Iloraz = Dzielna / Dzielnik
Range("F2").Value = Iloraz
Else
MsgBox "Dzielenie przez zero, wprowadź poprawną wartość"
End If
Exit Sub
problem:
MsgBox "Wystąpił błąd w programie. " & Err.Description & ", wprowadź poprawne wartości """
End Sub
Private Sub CommandButton1_Click()
On Error GoTo problem
Dim Dzielna, Dzielnik, Iloraz
Dzielna = Range("B2").Value
Dzielnik = Range("D2").Value
If Dzielnik <> 0 Then 'Operator użyty bezpośrednio w instrukcji.
Iloraz = Dzielna / Dzielnik
Range("F2").Value = Iloraz
Else
MsgBox "Dzielenie przez zero, wprowadź poprawną wartość"
End If
Exit Sub
problem:
MsgBox "Wystąpił błąd w programie. " & Err.Description & ", wprowadź poprawne wartości """
End Sub
Private Sub CommandButton1_Click()
On Error GoTo problem
Dim Warunek As Boolean
Dim Długość, Szerokość, Pole
Długość = Range("B2").Value
Szerokość = Range("D2").Value
Warunek = Długość > 0 And Szerokość > 0 'Operator And użyty w instrukcji przypisania.
If Warunek = True Then
If Długość > 100 Or Szerokość > 100 Then 'Operatora Or użyty bezpośrednią w instrukcji warunkowej.
MsgBox "Wprowadź poprawne wartości"
Else
Pole = Długość * Szerokość
Range("F2").Value = Pole
End If
Else
MsgBox "Wprowadź wartości większe od zera"
End If
Exit Sub
problem:
MsgBox "Wystąpił błąd w programie. " & Err.Description & "Wprowadź poprawnewartości """
End Sub
Private Sub CommandButton1_Click()
MsgBox "Witaj", vbOKCancel, "dzono4"
End Sub
Sub WyczyscWszystko()
Range("A1").Clear 'Za pomocą metody Clear czyścimy zawartość i przywracamy domyślne formatowanie komórkę A1 arkusza Excela.
End Sub
Sub WyczyscZawartosc()
Range("A1").ClearContents 'Wykorzystując metodę ClearContents czyścimy tylko zawartość komórki A1 arkusza.
End Sub
Sub WyczyscFormat()
Range("A1").ClearFormats 'Korzystając z metody ClearFormats przywracamy formatowanie domyślne dla komórki A1 .
End Sub
Sub WyczyscZakres()
Range("A1:D10").ClearContents 'Czyścimy zawartość komórek z zakresu A1:D10, analogicznie możemy zastosować metody Clear i ClearFormats.
End Sub
Sub Zapisywanie()
ActiveWorkbook.Save 'Metoda Save zapisuje obiekt, nasz kod powoduje zapisanie zmian w aktywnym dokumencie Excela.
End Sub
Sub Podgląd()
Worksheets("Arkusz1").PrintPreview 'Za pomocą metody PrintPreview wyświetlamy podgląd wydruku arkusza o nazwie Arkusza1.
End Sub
Sub Drukuj()
Range("B4:H22").PrintOut 'Metoda PrintOut drukuje wskazany obiekt. Powyższy kod spowoduje wydrukowanie zawartości zakresu komórek B2:H22, na domyślnej drukarce z domyślnymi (lub zdefiniowanymi wcześniej) opcjami.
End Sub
Private Sub Worksheet_Activate()
MsgBox "W arkuszu tym przechowywane są ważne dane, nie należy ich modyfikować", vbExclamation, "Autor"
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
MsgBox "W tym akuszu menu pod prawym przyciskiem jest wyłączone"
Cancel = True
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Target.Value = "Wykonano"
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$1" Then
MsgBox "Nastąpiła zmiana wartości w komórce A1", , "Autor Dzono4"
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.StatusBar = "Wiersz " & Target.Row & " kolumna " & Target.Column
End Sub