İşe Yarayan Kod Arşivi Burada

End Sub
------------------------------------------------------------
Formda Kayıt Üzerinde Değişiklik Yapılırsa Değişiklik Kaydedilsinmi Diye Sorsun
--------------------------------------------------------------------------------
Formun BeforeUpdate (Güncelleştirme öncesinde) bölümüne aşağıdaki kodu ekliyoruz. kayıt üzerinde değişiklik yapıldığında yüzde yüz etkili Umarım Faydalı olmuştur.
Private Sub Form_BeforeUpdate(Cancel As Integer)
If NewRecord = False Then 'Kayıt, Yeni Kayıt Değilse
If MsgBox( " Yapmış Olduğunuz Değişiklik Kaydedilsin mi?", vbYesNo + vbInformation, "Değişiklik onay") = vbNo Then
DoCmd.RunCommand acCmdUndo 'Hayır ise İşlemi Geri Al

End If
End If

End Sub

------------------------------------------------------------------
Formda Verileri Sıralama A-Z Veya Z-A Gibi
--------------------------------------------------------------------------------
Forma iki tane label Ekliyoruz isimlerine de birine 5, diğerine 6 isimler koyuyoruz. ve bunların yazı karekterini Webdings yapıyoruz. ve formun Option Compare Database in altına aşağıdaki kodu yapıştırıyoruz. Yapıştırdıktan sonra istediğimiz textbox verisini sıralamak için; örneğin Adresler textbox verilerini sıralamak için Label1 (veya ne isim verilecekse) tıklandığında bölümüne Sırala label1 (veya ne isim konulduysa) yazıyoruz. labelin İm bölümüne de textbox ın adını (Adresler)yazıyoruz. bu kadar
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_SHIFT = &H10


Private Sub sirala(labelx As Label)

On Error Resume Next

Dim fieldx As String
fieldx = labelx.Tag

If ((OrderBy = fieldx) Or (GetKeyState(VK_SHIFT) < 0)) Then
'Shift tuşu basılı ise ters sırala.
OrderBy = fieldx & " DESC"
labelYonasc.Visible = False
labelYonDESC.Visible = True
labelYonDESC.Left = labelx.Left + labelx.Width - 60
labelYonDESC.Top = labelx.Top - 20
Else
OrderBy = fieldx
labelYonDESC.Visible = False
labelYonasc.Visible = True
labelYonasc.Left = labelx.Left + labelx.Width - 60
labelYonasc.Top = labelx.Top - 20
End If

OrderByOn = True

End Sub

----------------------------------------------------
Alarmlı Konuşan Saat
--------------------------------------------------------------------------------
Alarmlı Konuşan Saat programı

Program herzaman üstte(always on top),ses dosyalarının sırayla çalınması, sağ tık menüsü özellikleri içeriyor.

'Module1 in kodları ----------------------------
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public alarm As Boolean
Public saatbasi As Boolean
Public alarmsaati As String
Public alarmdakikasi As String


'Ses dosyaları
'Programın bulunduğu dizinin altında "Sesler"
'adında bir dizin olmalı
'Sesler dizininin altındaki dosyalar :

'Dosya adı: İçeriği :
'---------- --------
'00.wav --- "SIFIR"
'10.wav --- "ON"
'20.wav --- "YİRMİ"
'30.wav --- "OTUZ"
'40.wav --- "KIRK"
'50.wav --- "ELLİ"
'Alarm.wav - Alarm zil sesi
'Bosluk.wav - Çok kısa bir boşluk
'Saat.wav - "SAAT"
'saat01.wav - "BİR"
'saat02.wav - "İKİ"
'saat03.wav - "ÜÇ"
'saat04.wav - "DÖRT"
'saat05.wav - "BEŞ"
'saat06.wav - "ALTI"
'saat07.wav - "YEDİ"
'saat08.wav - "SEKİZ"
'saat09.wav - "DOKUZ"
'saat10.wav - "ON"
'saat11.wav - "ONBİR"
'saat12.wav - "ONİKİ"
'-----------------------------------------------

'Form1 : Ana form

'Form1 in nesneleri:

'Label1 : Saatin yazılacağı etiket

'Label2 : am. pm. yazacak olan etiket

'MMControl1 : Ses dosyalarını çalmak için
'Microsoft multimedia control
'MCI32.OCX dosyası

'Timer1 :
'Enabled = True
'Interval = 500

'Timer2 :
'Enabled = False
'Interval = 10

'Timer3 :
'Enabled = False
'Interval = 1000



'Form1 in kodları ------------------------------
Dim yol(3) As String
Dim arttir As Byte
Dim yer As String
Dim alarmsesi As String
Dim bosluk As String
Dim alarmçaldi As Boolean
Dim alarm1 As Boolean
Dim alarmsusturuldu As Boolean
Dim saatisoyledi As Boolean
Dim kayit As String

Private Sub Form_Load()
yer = App.Path + "\sesler\"
alarmsesi = yer + "Alarm.wav"
bosluk = yer + "Bosluk.wav"

SetWindowPos hwnd, -1, 0, 0, 0, 0, &H1 Or &H2
If GetSetting("Konuşansaat", "Ayarlar", "Devrede") = "1" Then alarm = "1" Else alarm = "0"
If GetSetting("Konuşansaat", "Ayarlar", "Hsb") = "1" Then saatbasi = "1" Else saatbasi = "0"
alarmsaati = GetSetting("Konuşansaat", "Ayarlar", "Saat")
alarmdakikasi = GetSetting("Konuşansaat", "Ayarlar", "Dakika")
alarm1 = "1"
alarmsusturuldu = "0"
saatisoyledi = "0"
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub Label1_DblClick()
saatioku
End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
Call form2.PopupMenu(form2.Saat)
End If
End Sub

Private Sub Timer1_Timer()
Dim fark As Integer

If Val(Left(Time, 2)) > 12 Then
fark = Val(Left(Time, 2)) - 12
Label2 = "pm."
If fark < 10 Then
Label1 = "0" + Right(Str(fark), 1) + Right(Time, 6)
Else
Label1 = Right(Str(fark), 2) + Right(Time, 6)
End If
Else
If Left(Time, 2) = "00" Then Label1 = "12" + Right(Time, 6) Else Label1 = Time
Label2 = "am."
End If
If alarm = "1" And alarm1 = "1" Then alarmkontrol
If saatbasi = "1" Then saatbasikontrol
End Sub

Private Sub Timer2_Timer()
If MMControl1.Mode = 526 Then Exit Sub
arttir = arttir + 1
If arttir = 4 Then Timer2.Enabled = "0": MMControl1.Command = "close": Exit Sub
MMControl1.Command = "close"
MMControl1.FileName = yol(arttir)
MMControl1.Command = "open"
MMControl1.Command = "play"

End Sub

Public Sub saatioku()
If alarm1 = "0" And alarmsusturuldu = "0" Then
MMControl1.Command = "stop"
MMControl1.Command = "close"
alarmsusturuldu = "1"
Exit Sub
End If
If MMControl1.Mode = 526 Then Exit Sub

yol(0) = yer + "saat.wav"
yol(1) = yer + "saat" & Left(Label1, 2) & ".wav"
yol(2) = yer + Mid(Label1, 4, 1) & "0.wav"
If Mid(Label1, 4, 2) = "00" Then yol(2) = bosluk
yol(3) = yer + "saat0" & Mid(Label1, 5, 1) & ".wav"
arttir = 0
MMControl1.Command = "close"
MMControl1.FileName = yol(0)
MMControl1.Command = "open"
MMControl1.Command = "play"

Timer2.Enabled = "1"
End Sub

Public Sub alarmkontrol()
If Left(Label1, 2) = alarmsaati And Mid(Label1, 4, 2) = alarmdakikasi Then
If MMControl1.Mode = 526 Or alarm1 = "0" Then Exit Sub
MMControl1.Command = "close"
MMControl1.FileName = alarmsesi
MMControl1.Command = "open"
MMControl1.Command = "play"
alarm1 = "0"
saatbasi = "0"
kayit = Left(Time, 5)
Timer3.Enabled = "1"
End If
End Sub

Private Sub Timer3_Timer()
If kayit <> Left(Time, 5) Then
alarm1 = "1"
alarmsusturuldu = "0"
If GetSetting("Konuşansaat", "Ayarlar", "Hsb") = "1" Then saatbasi = "1" Else saatbasi = "0"
Timer3.Enabled = "0"
End If
End Sub

Public Sub saatbasikontrol()
If Mid(Label1, 4, 2) = "00" And saatisoyledi = "0" Then
saatioku
saatisoyledi = "1"
End If
If Mid(Label1, 4, 2) <> "00" Then saatisoyledi = "0"
End Sub
'-----------------------------------------------

'Form2 : Sağ tık menüsü

'Form2 nin nesneleri:

'Menü
'Caption = Saat
'Name = Saat
'Alt menü :
'1 : Caption = Ayarlar
' Name = ayarlar
'2 : Caption = Konuş
' Name = konus
'3 : Caption = Çıkış
' Name = cıkıs



'Form2 nin kodları -----------------------------
Private Sub ayarlar_Click()
Form3.Show
End Sub

Private Sub konus_Click()
Form1.saatioku
End Sub

Private Sub cıkıs_Click()
End
End Sub
'-----------------------------------------------



'Form3 : Alarm ayarlarının yapıldığı form

'Form3 ün nesneleri :
'Command1(0) : Tamam
'Command1(1) : İptal
'Command1(2) : Uygula

'Command2(0) : Alarm saatini 1 arttırmak için
'Caption = +1

'Command2(1) : Alarm saatini 1 eksiltmek için
'Caption = -1

'Command3(0) : Alarm dakikasını 10 arttırmak için
'Caption = +10

'Command3(1) : Alarm dakikasını 10 eksiltmek için
'Caption = -10

'Command3(2) : Alarm dakikasını 1 arttırmak için
'Caption = +1

'Command3(3) : Alarm dakikasını 1 eksiltmek için
'Caption = -1

'Label1(0) : Sadece Yazı
'Caption = Saat
'Label1(1) : Sadece Yazı
'Caption = Dakika

'Label2 : Alarm saatinin yazılacağı etiket
'Label3 : Alarm dakikasının yazılacağı etiket
'Option1 : am.
'Option2 : pm.
'Check1 : Alarm devrede
'Check2 : Her saat başı otomatik konuş



'Form3 ün kodları ------------------------------
Dim Saat As Integer
Dim dakika As Integer

Private Sub Command1_Click(Index As Integer)
If Index = 0 Then uygula: Unload Me
If Index = 1 Then Unload Me
If Index = 2 Then uygula
End Sub

Private Sub Command2_Click(Index As Integer)
Select Case Index

Case 0
Saat = Saat + 1
If Saat > 12 Then Saat = 12

If Saat < 10 Then
Label2 = "0" + Right(Str(Saat), 1)
Else
Label2 = Right(Str(Saat), 2)
End If

Case 1
Saat = Saat - 1
If Saat < 1 Then Saat = 1

If Saat < 10 Then
Label2 = "0" + Right(Str(Saat), 1)
Else
Label2 = Right(Str(Saat), 2)
End If

End Select

End Sub

Private Sub Command3_Click(Index As Integer)
Select Case Index

Case 0
dakika = dakika + 10
If dakika > 59 Then dakika = 59

If dakika < 10 Then
Label3 = "0" + Right(Str(dakika), 1)
Else
Label3 = Right(Str(dakika), 2)
End If

Case 1
dakika = dakika - 10
If dakika < 0 Then dakika = 0

If dakika < 10 Then
Label3 = "0" + Right(Str(dakika), 1)
Else
Label3 = Right(Str(dakika), 2)
End If

Case 2
dakika = dakika + 1
If dakika > 59 Then dakika = 59

If dakika < 10 Then
Label3 = "0" + Right(Str(dakika), 1)
Else
Label3 = Right(Str(dakika), 2)
End If

Case 3
dakika = dakika - 1
If dakika < 0 Then dakika = 0

If dakika < 10 Then
Label3 = "0" + Right(Str(dakika), 1)
Else
Label3 = Right(Str(dakika), 2)
End If

End Select

End Sub

Private Sub Form_Load()
On Error Resume Next
If GetSetting("Konuşansaat", "Ayarlar", "am-pm") = "0" Then Option1.Value = "1": Option2.Value = "0" Else Option1.Value = "0": Option2.Value = "1"
If GetSetting("Konuşansaat", "Ayarlar", "Devrede") = "1" Then Check1.Value = 1 Else Check1.Value = 0
If GetSetting("Konuşansaat", "Ayarlar", "Hsb") = "1" Then Check2.Value = 1 Else Check2.Value = 0
Label2.Caption = GetSetting("Konuşansaat", "Ayarlar", "Saat")
Label3.Caption = GetSetting("Konuşansaat", "Ayarlar", "Dakika")
Saat = Val(GetSetting("Konuşansaat", "Ayarlar", "Saat"))
dakika = Val(GetSetting("Konuşansaat", "Ayarlar", "Dakika"))

End Sub

Public Sub uygula()
If Option1.Value = "1" Then SaveSetting "Konuşansaat", "Ayarlar", "am-pm", "0" Else SaveSetting "Konuşansaat", "Ayarlar", "am-pm", "1"

If Check1.Value = 1 Then
SaveSetting "Konuşansaat", "Ayarlar", "Devrede", "1"
alarm = "1"
alarmsaati = Label2.Caption
alarmdakikasi = Label3.Caption
Else
SaveSetting "Konuşansaat", "Ayarlar", "Devrede", "0"
alarm = "0"
End If

If Check2.Value = 1 Then SaveSetting "Konuşansaat", "Ayarlar", "Hsb", "1": saatbasi = "1" Else SaveSetting "Konuşansaat", "Ayarlar", "Hsb", "0":: saatbasi = "0"

SaveSetting "Konuşansaat", "Ayarlar", "Saat", Label2.Caption
SaveSetting "Konuşansaat", "Ayarlar", "Dakika", Label3.Caption

End Sub

---------------------------------------------------
00.00.00.00 (Kronometre)
--------------------------------------------------------------------------------
Forma 4 label,1 buton ve 1 timer yerleştirin.Aşağıdaki kodları kod sayfasına yapıştırın.Sonuçta butonu tıklayınca kronometre çalışsın.
Dim a As Integer, b As Integer, c As Integer, d As Integer
Private Sub Command1_Click()
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
Label1.Caption = "00"
Timer1.Enabled = False

Label2.Caption = "00"
Label3.Caption = "00"
Label4.Caption = "00"
Command1.Caption = "başla"
Timer1.Interval = 1
End Sub
Private Sub Timer1_Timer()
a = a + 1
Label1.Caption = a
If a = 99 Then
b = b + 1
If b < 10 Then
Label2.Caption = "0" & b
Else
Label2.Caption = b
End If
a = 0
End If
If b = 60 Then
b = 0
c = c + 1
Label3.Caption = c
End If
If c = 60 Then
c = 0
d = d + 1
Label4.Caption = d
End If
End Sub

-------------------------------------------------------
Listeye Eleman Ekleme
--------------------------------------------------------------------------------
Dim isim(95), tel(95) As Integer
ksay = InputBox("kaç kişi girilcek")

For i = 0 To ksay - 1

isim(i) = InputBox(i & "kişinin adını girin")
tel(i) = InputBox(isim(i) & "kişinin adını girin")
List1.AddItem isim(i)
List2.AddItem tel(i)

------------------------------------------------------------------------------
Projeniz Konuşsun
--------------------------------------------------------------------------------
Text kutusundaki yazıyı Sese çeviren kod...
Formumuza Project > References Menüsünden "Microsoft Speech Object Library" adli Referenceyi ekliyoruz.

Daha Sonra Formumuza Bir TextBox birde Button Ekliyoruz Ve Code Bölümünü açıp Bunu Yazıyoruz ;

Dim speech As SpVoice
Private Sub Command1_Click()
speech.Speak Text1
End Sub
Private Sub Form_Load()
Set speech = New SpVoice
End Sub

---------------------------------------------------------
Son Kullanılan Dosyaları Silmek
--------------------------------------------------------------------------------
Aslında istediğimiz dosyaları silmek

Private Sub Form_Load()

Dim silgi As Object 'Nesne değişkeni tanımlanıyor.
Set silgi = CreateObject("Scripting.FileSystemObject") 'Nesne yaratılıp değişkene atanıyor
MsgBox ("Son Kullanılan dosyaları siliyorum")
silgi.DeleteFile "C:\Documents and Settings\Administrator\Recent\*.*" 'Nesnenin DeleteFile yöntemi çalıştırılıyor.Son kullanılan dosyaların yolu giriliyor.
End

End Sub


Silmek istediğiniz herhangibir yolu yazınız.Kodda yazılı olan yol sizin bilgisayarınızda farklı olabilir.Koddaki sadece bir örnektir

--------------------------------------------------------
Girilen Metnin Tersini Yazdırma...
--------------------------------------------------------------------------------
Girilen bir metnin tersten okunuşunu yazdırmak içim geken visula basic kodunu içerir...
Private Sub CommandButton2_Click()
Dim d As String
Dim i As Byte
Dim c As Integer
d = InputBox("")
i = 1
c = Len(d) + 1
tt.Text = ""
For i = 1 To Len(d)
c = c - 1
tt.Text = tt.Text + Mid(d, c, 1)
Next i
End Sub

----------------------------------------------------
Kaydetme Düzeltme Arama Silme Yapabilen Program
--------------------------------------------------------------------------------
Ado veya Data ile datagrid aracılığı ile kaydetme arama silme düzeltma butonlarını anlatıcam
Sevgili arkadaşlar önceli le sizlere basit 2 kayıt giricez bu kayıdı kaydedicez düzelticez birden fazla girilen kaydı aratıcaz silme işlemini ve yeni kayıt girme işlemini anlatıcam

Şimdi iki kayıt gireceğimiz için;
2 tane text kutusu
4 adet command buton
Ado Nesnemiz
datagrid Nesnemiz

not: Bu nesneleri Project-Component bölümünden bulabilirsiniz.

Arkadaşlar adolara ve buton isimlerine dikkat edin sizde aynı isimler kullanın.

Kodlara Gelelim Artık;

//Yeni Kayıt Botonu
Private Sub cmdekle_Click()
Adodc7.Recordset.AddNew
cmdkaydet.Enabled = True
cmdekle.Enabled = False

Text1.SetFocus
End Sub

//Kaydet/Güncelle Butonu
Private Sub cmdkaydet_Click()
If Text1.Text <> "" Then

Adodc1.Recordset.Update
Else
Adodc1.Recordset.CancelUpdate


End If


MsgBox ("Kayıt Yapıldı")
End Sub

//Ara Butonu
Private Sub Command4_Click()
On Error Resume Next
Dim sql As String

sql = "select * from deneme where num like '%" & Text1.Text & "%'"

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = sql
Adodc1.*******
Set DataGrid1.DataSource = Adodc1
End Sub


Arkadaşlar ara butonunda gördüğünüz gibi deneme tablomuzdan num aaa göre arama yapmakta yani sizin bunları yapabilmeniz için biliosunuz kiii access bir veri tabanı oluşturmanız gerekmekte ve deneme adında tablo açıp numara ve adsoyad bilgileri gibi iki bilgilik bir tablo yapmanız gerekir. Zaten bu iki bilgili veritabanlı programlar yapabilirseniz harika programlar ve satabileceğiniz programlar yapabilirsiniz ben sizlere temelini anlatıorum.

//Sil Butonu
Private Sub Command5_Click()
Dim mesaj As String
mesaj = "Kaydı silmek istediğinizden eminmisiniz.?"

If MsgBox(mesaj, vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
Adodc1.Recordset.Delete 'Kaydı sil
Adodc1.Recordset.MoveNext 'sonraki kayda konumlan...
If Adodc1.Recordset.EOF Then
If Adodc1.Recordset.RecordCount > 0 Then
Adodc1.Recordset.MoveLast
End If
End If
End If
End Sub

( ALINTIDIR )