KODY.doc

Sprawdzanie czy jest liczbą pierwszą

Uzytkownik zaznacza obszar wpisuje pierwszą liczbę a potem zaznacza na czerwono liczby pierwsze.

Function czy_pierwsza(liczba As Long) As Boolean

czy_pierwsza = True

Dim i As Long

i = 2

Dim pierwiastek_z_liczba As Long

pierwiastek_z_liczba = Int(Sqr(liczba))

For i = 2 To pierwiastek_z_liczba

If liczba Mod i = 0 Then

    czy_pierwsza = False

    Exit Function

    End If

Next i

End Function

Zaznaczanie liczb pierwszych

Sub zaznacz_pierwsze()

Dim i As Long, komorka As Range

Dim wartosc As Long

i = 1

For Each komorka In Selection

wartosc = komorka.Value

Exit For

Next komorka

For Each komorka In Selection

komorka = wartosc

wartosc = wartosc + 1

Next komorka

For Each komorka In Selection

    If czy_pierwsza(komorka.Value) = True Then

    komorka.Interior.ColorIndex = 6

    End If

Next komorka

End Sub

Tylko liczby pierwsze

Sub wypelnij_pierwszymi()

Dim i As Long, komorka As Range

i = 1

For Each komorka In Selection

While czy_pierwsza(i) = False

i = i + 1

Wend

komorka = i

i = i + 1

Next komorka

End Sub

makro wypisuje liczby pierwsze na zaznaczonym obszarze

Ciąg geometryczny

Sub ciag_geom()

Dim a, b, c, nty_wyraz As Double

a = Range("a1").Value

b = Range("a2").Value

c = Range("a3").Value

Range("b1").Value = a * b ^ (c - 1)

End Sub

Ciąg geometryczny z liczb pierwszych

Sub ciag_geom_all()

Dim a, b, c, nty_wyraz As Double

Dim wiersz As Integer

Function czy_pierwsza(Liczba As Long) As Boolean

Dim komorka As Range

Dim i As Integer

i = 2

czy_pierwsza = Fałsz

Do While i <= Liczba - 1

If Liczba Mod i <> 0 Then

czy_pierwsza = True

i = i + 1

Else

czy_pierwsza = False

Exit Do

End If

Loop 

End Function

Ciąg geometryczny 2

Sub ciag_geom()

Dim a, b, c, nty_wyraz As Double

a = Range("a1").Value

b = Range("a2").Value

c = Range("a3").Value

Range("b1").Value = a * b ^ (c - 1)

End Sub

Ciąg geometryczny z liczb pierwszych 2

Sub ciag_geom_all()

Dim a, b, c, nty_wyraz As Double

Dim wiersz As Integer

wiersz = 1

a = Range("a1").Value

b = Range("a2").Value

c = Range("a3").Value

For i = 1 To c

Cells(wiersz, 4).Value = a * b ^ (i - 1)

wiersz = wiersz + 1

Next i

End Sub

Tabliczka mnożenia

Sub tabliczka_mnozenia()

Dim wiersz, kolumna As Integer

Range("A1:A10").Interior.ColorIndex = 6

Range("A1:J1").Interior.ColorIndex = 6

For wiersz = 1 To 10

    For kolumna = 1 To 10

        Cells(wiersz, kolumna) = wiersz * kolumna

    Next kolumna

Next wiersz

End Sub

Zaznaczanie liczb parzystych

Sub zaznaczanie_parz()

Dim wiersz, kolumna, i As Integer

Dim komorka As Range

i = 1

wiersz = 1

kolumna = 1

For Each komorka In Selection

komorka.Value = i

i = i + 1

Next komorka

For Each komorka In Selection

If komorka.Value Mod 2 = 0 Then

komorka.Interior.ColorIndex = 6

End If

Next komorka

End Sub

'' to samo tylko w komorkach od 1 do 10

'' Dim m, k

''For m = 1 To 10

''For k = 1 To 10

''If Cells(m, k).Value Mod 2 = 0 Then

''Cells(m, k).Activate

''ActiveCell.Interior.ColorIndex = 6

''End If

''Next k

''Next m

Sub form1()

UserForm1.Show

End Sub

Błędy

Sub blad()

Dim w As Integer

On Error GoTo blad

w = 13.213

blad:

If Err.Number = 13 Then

MsgBox "wystapil blad 13"

Else

MsgBox "wystapil jakis inny blad " & Err.Number

End If

Exit Sub

End Sub

Wyświetlanie napisów

Private Sub CommandButton1_Click()

If IsNumeric(TextBox1) = False Then

MsgBox "zle"

Else

MsgBox "dobrze"

End If

End Sub

Wykresy

Sub rob_wykres()

'

' rob_wykres Makro

'

' Klawisz skrótu: Ctrl+w

'

    Range(Selection, Selection.End(xlDown)).Select

    Range(Selection, Selection.End(xlUp)).Select

    Range(Selection, Selection.End(xlDown)).Select

End Sub

Sub zrob_wykres()

'

' zrob_wykres Makro

'

' Klawisz skrótu: Ctrl+d

'

    Range(Selection, Selection.End(xlDown)).Select

    ActiveSheet.Shapes.AddChart.Select

    ActiveChart.SetSourceData Source:=Range("'Arkusz2'!$A$1:$A$11")

    ActiveChart.ChartType = xlColumnClustered

End Sub

Sub linia_trendu()

'

' linia_trendu Makro

'

' Klawisz skrótu: Ctrl+t

'

    ActiveSheet.Activate

    ActiveChart.SeriesCollection(1).Select

    ActiveChart.SeriesCollection(1).Trendlines.Add

    ActiveSheet.Activate

    ActiveChart.SeriesCollection(1).Trendlines(1).Select

End Sub

Komendy SQL

Select

pobierz_dane_z_bazy()

' potrzebna biblioteka MS ActiveX data objects 2.8 recordset ...

On Error Resume Next

Dim polacz As New ADODB.Connection

Dim serwer As String

serwer = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\d1\Moje dokumenty\magazyn.mdb;Persist Security Info=False"

polacz.Open serwer

Dim rekordy As New Recordset

rekordy.Open Range("A1").Value, polacz

If Err.Number <> 0 Then

    MsgBox "nie udało się wykonac instrukcji"

    Exit Sub

End If

Dim i As Integer

i = 0

Dim pole As Field

For Each pole In rekordy.Fields

    'Range("b2").Offset(0, i) = rekordy.Fields(i).Name

    Range("b2").Offset(0, i) = pole.Name

    i = i + 1

Next pole

End Sub

Update i insert

Sub dopisz_do_bazy()

Dim polacz As New ADODB.Connection

Dim serwer As String

serwer = "Provider=Microsoft.Jet.OLEDB.4.0:Data Source=C:\Documents and Settings\d1\Moje dokumenty\magazyn.mdb;Persist Security Info=False"

polacz.Open serwer

Dim sql_txt As String

sql_txt = "insert into magazyn(nazwa_produktu, stan_magazynowy) values('" & Range("i2").Value & "', " & Range("i3").Value & ")"

polacz.Execute sql_txt

End Sub

Oblicza pole kwadratu

Sub ObliczPole()

Dim wartość, pole

  wartość = InputBox("Podaj długość boku kwadratu do obliczenia pola powierzchni")

If IsNumeric(wartość) = True Then

  If wartość > 0 Then

   pole = PoleKwadratu(wartość) ' wywołujemy funkcje PoleKwadratu.

   MsgBox "Pole kwadratu wynosi " & pole

  Else

  MsgBox "BłędnaWartość" ' wywołujemy podprogram BłędnaWartość.

  End If

End If

End Sub

Tabliczka mnozenia

Sub PrzykładPętli1()

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

Jesli cos wpiszesz tu to cos  ci wyjdzie tam

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

Wyszukuje i zapelnia na czerwono komorke w ktorej jest ujemna liczba

Sub Wyszukaj()

For Each element In Range("A1:J25")

  If IsNumeric(element.Value) = True Then

   If element.Value < 0 Then

    element.Interior.ColorIndex = 3

    Exit For

   End If

  End If

Next

End Sub

Okno komunikatu funkcji MsgBox

Przykład 1:

MsgBox "Witaj" ' Wyświetlane jest okno komunikatu z komunikatem Witaj.

Przykład 2:

MsgBox "Witaj" & " Przyjacielu" ' Wyświetlane jest okno komunikatu z komunikatem Witaj Przyjacielu. Do połączenia wyrazów użyliśmy operatora &.

Przykład 3:

MsgBox "Witaj" & Chr(10) & "Przyjacielu" ' Wyświetlane jest okno komunikatu z komunikatem umieszczonym w dwóch wierszach: górny to słowo Witaj dolny słowo Przyjacielu. Dla osiągnięcia tego efektu zastosowaliśmy znak nowego wiersza Chr(10), do połączenia wyrazów wykorzystaliśmy też operator łączący&.

Przykład 4:

MsgBox "Witaj", , "dzono4" ' Wyświetlane jest okno komunikatu z komunikatem Witaj a na pasku tytułu napis dzono4. Pominęliśmy wartość argumentu buttons stawiając sam przecinek, brak tego parametru spowoduje przyjęcie wartości domyślnej 0.

Przykład 5:

MsgBox "Witaj", VbOKCancel, "dzono4" ' Wyświetlane jest okno komunikatu z komunikatem Witaj i dwoma przyciskamy Ok i Anuluj. Na pasku tytułu napis dzono4. Parametr buttons określa stała VbOKCancel.

Przykład 6:

MsgBox "Witaj", 321, "dzono4" ' W przykładzie argumeny buttons jest określony za pomącą wartości liczbowych. Dla przypomnienia dodam, że z każdej grupy ustawień argumentu buttons należy wybrać tylko jedną wartość i te wartość zsumować. Proponuję zastanowić się dlaczego niektóre ustawienia wartości argumentu buttons mają wartość 0.

Przykład 7:

MsgBox "Czy jesteś zadowolony ze swoich zarobków?", VbYesNo + VbInformation + VbDefaultButton1, "Kierownik" ' Wyświetlane jest okno komunikatu z pytaniem, dwoma przyciskami Tak i Nie oraz ikona Komunikat informacyjny. Na pasku tytułu napis Kierownik, domyślnym przyciskiem jest przycisk pierwszy (Tak).

Przykład 8:

Dim Kom, Styl, Tytul
 Kom = "Czy jesteś zadowolony ze swoich zarobków?"
 Styl = VbYesNo + VbInformation + VbDefaultButton1
 Tytul = "Kierownik"
  MsgBox Kom, Styl, Tytul ' Przykład ten wyświetla okno komunikatu identyczne jak wyżej, różnica polega na formie zapisu. Deklarujemy zmienne i określamy wartości, wartości przypisujemy zmiennym. Jako argumenty funkcji MsgBox wpisujemy nazwy zmiennych.

Przykład 9:

Dim Odp, Kom, Styl, Tytul
 Kom = "Czy jesteś zadowolony ze swoich zarobków?"
 Styl ...