[Yardım]  Access e Veri Kaydetme

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Cevap: Access e Veri Kaydetme

İleti#21)  cadriano » 03 Nis 2019 19:37

Batur Bey Tekrardan merhaba.
Siden çok özür diliyorum bir ricam daha olacaktı malesef programı kullandıkça eksikliklerini keşfediyorum.
Bildiğiniz gibi (G) sütununda yukarıdan aşağı dğru telefon numaraları mevcut istediğim şey tekraralayan telefon numaraları için uyarı versin bunu yaparken referans veren yani (B) sütünunda yukarıdan aşağı dğru bulunan veri ve Hangi tarihte verdiği yani (A) sütünunda bulunan yukarıdan aşağı dğru kayıt tarihi. bunları meaj olarak uyarı versin istiyorum ama kaydı engellemesin kayedetmek için onay istesin ben evet dersem .. Yardım ederseniz çok sevinirim şimdiden çok teşekkür ederim.


Private Sub btnKaydet_Click()
On Error GoTo Hata_Isleyicisi
Application.ScreenUpdating = False
If Len(Trim(frmReferansTakip.txtKayitTarih.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Kayıt Tarihi Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.txtKayitTarih.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.txtReferansVeren.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Referans Vereni Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.txtReferansVeren.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.txtAdSoyaAd.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Ad Soyad Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.txtAdSoyaAd.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.cmbMeslek.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Meslek Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.cmbMeslek.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.cmbYakinligi.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Yakınlık Derecesini Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.cmbYakinligi.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.txtTelefon1.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat En Az Bir Telefon Numarası Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.txtTelefon1.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.cmdSehir.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Yaşadığı Şehir Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.cmdSehir.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.cmbIlceSemt.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat İlçe Semt Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.cmbIlceSemt.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.txtAciklama.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Not Bilgi Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.txtAciklama.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
Call frmReferansTakip.cnnBaglan
If Len(Trim(frmReferansTakip.txtKayitNo.Value & vbNullString)) > 0 Then
sifre = InputBox("Dikkat ! Yetkili Şifreyi Girmeden Bu Kayıtta Düzenleme Yapamazsınız...", _
"Uyarı", "")
If sifre = "1231" Then
Else
MsgBox "Hatalı Şifre İşlem Başarısız Oldu..."
Cancel = True
Exit Sub
End If
lngSiraNo = "" & frmReferansTakip.txtKayitNo & ""
dateKayitTarih = "'" & Format(frmReferansTakip.txtKayitTarih, "dd.mm.yyyy") & "'"
strReferansVeren = "'" & frmReferansTakip.txtReferansVeren & "'"
strAdiSoyadi = "'" & frmReferansTakip.txtAdSoyaAd & "'"
strMeslegi = "'" & frmReferansTakip.cmbMeslek & "'"
strYakinligi = "'" & frmReferansTakip.cmbYakinligi & "'"
strTel1 = "'" & frmReferansTakip.txtTelefon1 & "'"
strYasadigiSehir = "'" & frmReferansTakip.cmdSehir & "'"
strIlceSemt = "'" & frmReferansTakip.cmbIlceSemt & "'"
strNotBilgiler = "'" & frmReferansTakip.txtAciklama & "'"
dateUyariTarih = "'" & Format(frmReferansTakip.txtUyariTarih, "dd.mm.yyyy") & "'"
Set rst = cnn.Execute("UPDATE Data SET Kayit_Tarihi=" & dateKayitTarih & ",Referans_Veren=" & strReferansVeren & ",Adi_Soyadi=" & strAdiSoyadi & ",Yakinligi=" & strYakinligi & ",Tel_1=" & strTel1 & ",Yasadigi_Sehir=" & strYasadigiSehir & ",Ilce_Semt=" & strIlceSemt & ",Not_Bilgiler=" & strNotBilgiler & ",Uyari_Tarihi=" & dateUyariTarih & " WHERE Sira_No=" & lngSiraNo)
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(46, 204, 113)
.Caption = "Kayıt Başarıyla Güncellendi !..."
On Error GoTo Hata_Isleyicisi
Application.ScreenUpdating = False
On Error Resume Next
Call frmReferansTakip.Temizle
Call frmReferansTakip.cnnKapat
Call UserForm_Initialize
Application.ScreenUpdating = True
cmdSehir.Value = "Muğla"
cmbIlceSemt.Value = "Merkez"
txtReferansVeren.SetFocus
lstListele.ColumnWidths = "1"
Exit Sub
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(80)
.Left = 60
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
Else
dateKayitTarih = "'" & Format(frmReferansTakip.txtKayitTarih, "dd.mm.yyyy") & "'"
strReferansVeren = "'" & frmReferansTakip.txtReferansVeren & "'"
strAdiSoyadi = "'" & frmReferansTakip.txtAdSoyaAd & "'"
strMeslegi = "'" & frmReferansTakip.cmbMeslek & "'"
strYakinligi = "'" & frmReferansTakip.cmbYakinligi & "'"
strTel1 = "'" & frmReferansTakip.txtTelefon1 & "'"
strYasadigiSehir = "'" & frmReferansTakip.cmdSehir & "'"
strIlceSemt = "'" & frmReferansTakip.cmbIlceSemt & "'"
strNotBilgiler = "'" & frmReferansTakip.txtAciklama & "'"
dateUyariTarih = "'" & Format(frmReferansTakip.txtUyariTarih, "dd.mm.yyyy") & "'"
Set rst = cnn.Execute("INSERT INTO Data(Kayit_Tarihi,Referans_Veren,Adi_Soyadi,Meslegi,Yakinligi,Tel_1,Yasadigi_Sehir,Ilce_Semt,Not_Bilgiler,Uyari_Tarihi) VALUES (" & dateKayitTarih & "," & strReferansVeren & "," & strAdiSoyadi & "," & strMeslegi & "," & strYakinligi & "," & strTel1 & "," & strYasadigiSehir & "," & strIlceSemt & "," & strNotBilgiler & "," & dateUyariTarih & ")")
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(46, 204, 113)
.Caption = "Yeni Kayıt Başarıyla Tamamlandı !..."
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(80)
.Left = 60
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
End If
Sonlandir:
On Error Resume Next
txtAdSoyaAd.Value = ""
cmbMeslek.Value = ""
cmbYakinligi.Value = ""
txtTelefon1.Value = ""
cmdSehir.Value = ""
cmbIlceSemt.Value = ""
txtAciklama.Value = ""
txtUyariTarih.Value = ""
cmdSehir.Value = "Muğla"
cmbIlceSemt.Value = "Merkez"
txtAdSoyaAd.SetFocus
lstListele.ListIndex = say - 1
Call frmReferansTakip.cnnKapat
Call UserForm_Initialize
Application.ScreenUpdating = True
lstListele.ColumnWidths = "1"
Exit Sub
Hata_Isleyicisi:
MsgBox "Programda Hata Oluştu." & vbCrLf & vbCrLf & _
"Hata Kodu: " & Err.Number & vbCrLf & _
"Hata Tanımı: " & Err.Description, vbCritical, "Bir hata oluştu!"
mdlHata.HataKayit "btnkaydet", Err.Number, Err.Description
Resume Sonlandir
End Sub
Kullanıcı avatarı
cadriano
Siteye Alışmış
 
Adı Soyadı:enver caliskan
Kayıt: 01 Oca 2011 04:56
İleti: 136
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İtalya

Cevap: Access e Veri Kaydetme

İleti#22)  batur_00 » 04 Nis 2019 09:11

Private Sub btnKaydet_Click()
On Error GoTo Hata_Isleyicisi
Dim Kntrl As String
Dim intCancel As Integer
Dim byteSor As Byte
Application.ScreenUpdating = False
If Len(Trim(frmReferansTakip.txtKayitTarih.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Kayıt Tarihi Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.txtKayitTarih.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.txtReferansVeren.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Referans Vereni Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.txtReferansVeren.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.txtAdSoyaAd.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Ad Soyad Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.txtAdSoyaAd.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.cmbMeslek.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Meslek Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.cmbMeslek.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.cmbYakinligi.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Yakınlık Derecesini Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.cmbYakinligi.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.txtTelefon1.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat En Az Bir Telefon Numarası Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.txtTelefon1.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.cmdSehir.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Yaşadığı Şehir Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.cmdSehir.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.cmbIlceSemt.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat İlçe Semt Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.cmbIlceSemt.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
If Len(Trim(frmReferansTakip.txtAciklama.Value & vbNullString)) = 0 Then
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(255, 0, 0)
.Caption = "Dikkat Not Bilgi Girmelisiniz !"
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(86)
.Left = 90
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
frmReferansTakip.txtAciklama.SetFocus
Application.ScreenUpdating = True
Exit Sub
End If
Call frmReferansTakip.cnnBaglan
If Len(Trim(frmReferansTakip.txtKayitNo.Value & vbNullString)) > 0 Then
sifre = InputBox("Dikkat ! Yetkili Şifreyi Girmeden Bu Kayıtta Düzenleme Yapamazsınız...", _
"Uyarı", "")
If sifre = "1231" Then
Else
MsgBox "Hatalı Şifre İşlem Başarısız Oldu..."
Cancel = True
Exit Sub
End If
lngSiraNo = "" & frmReferansTakip.txtKayitNo & ""
dateKayitTarih = "'" & Format(frmReferansTakip.txtKayitTarih, "dd.mm.yyyy") & "'"
strReferansVeren = "'" & frmReferansTakip.txtReferansVeren & "'"
strAdiSoyadi = "'" & frmReferansTakip.txtAdSoyaAd & "'"
strMeslegi = "'" & frmReferansTakip.cmbMeslek & "'"
strYakinligi = "'" & frmReferansTakip.cmbYakinligi & "'"
strTel1 = "'" & frmReferansTakip.txtTelefon1 & "'"
strYasadigiSehir = "'" & frmReferansTakip.cmdSehir & "'"
strIlceSemt = "'" & frmReferansTakip.cmbIlceSemt & "'"
strNotBilgiler = "'" & frmReferansTakip.txtAciklama & "'"
dateUyariTarih = "'" & Format(frmReferansTakip.txtUyariTarih, "dd.mm.yyyy") & "'"
Set rst = cnn.Execute("UPDATE Data SET Kayit_Tarihi=" & dateKayitTarih & ",Referans_Veren=" & strReferansVeren & ",Adi_Soyadi=" & strAdiSoyadi & ",Yakinligi=" & strYakinligi & ",Tel_1=" & strTel1 & ",Yasadigi_Sehir=" & strYasadigiSehir & ",Ilce_Semt=" & strIlceSemt & ",Not_Bilgiler=" & strNotBilgiler & ",Uyari_Tarihi=" & dateUyariTarih & " WHERE Sira_No=" & lngSiraNo)
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(46, 204, 113)
.Caption = "Kayıt Başarıyla Güncellendi !..."
On Error GoTo Hata_Isleyicisi
Application.ScreenUpdating = False
On Error Resume Next
Call frmReferansTakip.Temizle
Call frmReferansTakip.cnnKapat
Call UserForm_Initialize
Application.ScreenUpdating = True
cmdSehir.Value = "Muğla"
cmbIlceSemt.Value = "Merkez"
txtReferansVeren.SetFocus
lstListele.ColumnWidths = "1"
Exit Sub
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(80)
.Left = 60
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
Else
If Len(Trim(frmReferansTakip.txtTelefon1.Value & vbNullString)) > 0 Then
rst.Open "SELECT * FROM Data WHERE Data.[Tel_1]='" & frmReferansTakip.txtTelefon1 & "' ORDER BY Data.Sira_No DESC", cnn, 1, 1
If Not rst.BOF And Not rst.EOF And rst.RecordCount > 0 Then
Do
Kntrl = Kntrl & vbNewLine & rst.Fields("Referans_Veren").Value & vbTab & rst.Fields("Kayit_Tarihi").Value
rst.MoveNext
Loop Until rst.EOF

byteSor = MsgBox("Bu Telefon Numarası Daha Önce Şu Kayıtlarda Mevcuttur" & vbNewLine & Kntrl & vbNewLine & "Yinede Kayıt Etmek İstiyormusunuz", vbYesNo + vbQuestion, "")
Select Case byteSor
Case 6
GoTo Kayit
Case 7
Call frmReferansTakip.cnnKapat
intCancel = True
Application.ScreenUpdating = True
Exit Sub
End Select
Else
GoTo Kayit
End If
End If

Kayit:
dateKayitTarih = "'" & Format(frmReferansTakip.txtKayitTarih, "dd.mm.yyyy") & "'"
strReferansVeren = "'" & frmReferansTakip.txtReferansVeren & "'"
strAdiSoyadi = "'" & frmReferansTakip.txtAdSoyaAd & "'"
strMeslegi = "'" & frmReferansTakip.cmbMeslek & "'"
strYakinligi = "'" & frmReferansTakip.cmbYakinligi & "'"
strTel1 = "'" & frmReferansTakip.txtTelefon1 & "'"
strYasadigiSehir = "'" & frmReferansTakip.cmdSehir & "'"
strIlceSemt = "'" & frmReferansTakip.cmbIlceSemt & "'"
strNotBilgiler = "'" & frmReferansTakip.txtAciklama & "'"
dateUyariTarih = "'" & Format(frmReferansTakip.txtUyariTarih, "dd.mm.yyyy") & "'"
Set rst = cnn.Execute("INSERT INTO Data(Kayit_Tarihi,Referans_Veren,Adi_Soyadi,Meslegi,Yakinligi,Tel_1,Yasadigi_Sehir,Ilce_Semt,Not_Bilgiler,Uyari_Tarihi) VALUES (" & dateKayitTarih & "," & strReferansVeren & "," & strAdiSoyadi & "," & strMeslegi & "," & strYakinligi & "," & strTel1 & "," & strYasadigiSehir & "," & strIlceSemt & "," & strNotBilgiler & "," & dateUyariTarih & ")")
Call mdlMesaj.RfrnsTkpMsj
With frmReferansTakip.lblMesaj
.BackColor = RGB(46, 204, 113)
.Caption = "Yeni Kayıt Başarıyla Tamamlandı !..."
End With
With frmReferansTakip.lblMesajSimge
.Caption = Chr(80)
.Left = 60
End With
Application.OnTime (Now() + TimeValue("00:00:03")), "mdlMesaj.RfrnsTkpKapat"
End If
Sonlandir:
On Error Resume Next
txtAdSoyaAd.Value = ""
cmbMeslek.Value = ""
cmbYakinligi.Value = ""
txtTelefon1.Value = ""
cmdSehir.Value = ""
cmbIlceSemt.Value = ""
txtAciklama.Value = ""
txtUyariTarih.Value = ""
cmdSehir.Value = "Muğla"
cmbIlceSemt.Value = "Merkez"
txtAdSoyaAd.SetFocus
lstListele.ListIndex = say - 1
Call frmReferansTakip.cnnKapat
Call UserForm_Initialize
Application.ScreenUpdating = True
lstListele.ColumnWidths = "1"
Exit Sub
Hata_Isleyicisi:
MsgBox "Programda Hata Oluştu." & vbCrLf & vbCrLf & _
"Hata Kodu: " & Err.Number & vbCrLf & _
"Hata Tanımı: " & Err.Description, vbCritical, "Bir hata oluştu!"
mdlHata.HataKayit "btnkaydet", Err.Number, Err.Description
Resume Sonlandir
End Sub
Kullanıcı avatarı
batur_00
Siteye Alışmış
 
Kayıt: 05 Ekm 2014 22:39
Meslek: tekstil işçisi
Yaş: 41
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa-Orhangazi

Cevap: Access e Veri Kaydetme

İleti#23)  cadriano » 04 Nis 2019 23:33

Batur bey
Harikasınız gerçekten çok çok çok teşekkür ediyorum elleriniz dert görmesin ALLAH sizdeN razı olsun
iyi çalışmalar diliyorum.. şkşk şkşk şkşk
Kullanıcı avatarı
cadriano
Siteye Alışmış
 
Adı Soyadı:enver caliskan
Kayıt: 01 Oca 2011 04:56
İleti: 136
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İtalya

CheckBox ile ilgili sayfaya kopyalama

İleti#24)  cadriano » 10 Nis 2019 18:10

Saygı değer arkadaşlar herkeze selamlar.
Referans takip adlı kendimce bir form yapmaya çalıştım bu süreçte batur beyin ve diğer saygıdeğer ustadlarımın katkıları çok oldu
kendilerine çok teşekkür ediyorum
Fakat programı kulandıkça ihtiyaçlar doğuyor bu yüzden sizleden sürekli yardım talep etmek zorunda kalıyorum şimdiden çok özür diliyorum.


Sorunuma gelince
Form üzerinde 4 adet CheckBox bulunuyor (Aranacaklar) (Arananlar) (Ertelenenler) (Kırmızı Liste) adlı.
İstediğim şey Listbox da seçtiğim herhangi bir satırı hangi CheckBox u işaretler isem ekle butonu ile access veri tabanındaki ilgili sayfaya veri olan bir alt satırın altına verileri kopyalaması. Üstadlarımdan ricam eğer lisboxdan coklu seçim yaparakta yapabilirsek benim için çok daha iyi olur. Herşey hazır sadecek kodlar yazılacak.
İlgilenene üstadlarıma şimdiden çok çok teşekkür ederim...
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
cadriano
Siteye Alışmış
 
Adı Soyadı:enver caliskan
Kayıt: 01 Oca 2011 04:56
İleti: 136
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İtalya

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Access e Veri Kaydetme

İleti#25)  cadriano » 13 Nis 2019 06:42

Saygıdeğer üstadlarım sorunumla ilgili çok araştırma yaptım ama malesef çözebilmiş yardım ederseniz çok memnun kalırım [uzgun] [uzgun] [uzgun] Teşekkür ederim...
Kullanıcı avatarı
cadriano
Siteye Alışmış
 
Adı Soyadı:enver caliskan
Kayıt: 01 Oca 2011 04:56
İleti: 136
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İtalya

Cevap: Access e Veri Kaydetme

İleti#26)  batur_00 » 13 Nis 2019 14:12

Kayıt Userformunda option butonlar ile yeni kayıt veya günceleme ile data sayfasına kayıt eder.
Durum listele userformun da, comboboxtan seçime göre listeler. Liste üzerinden seçilen kayıtları option butondan belirlediğiniz duruma Kaydet butonu ile güncelleyebilirsiniz. Dosya ektedir Deneyebilir misiniz.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
batur_00
Siteye Alışmış
 
Kayıt: 05 Ekm 2014 22:39
Meslek: tekstil işçisi
Yaş: 41
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa-Orhangazi

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Access e Veri Kaydetme

İleti#27)  batur_00 » 13 Nis 2019 15:55

Her zamanki gibi api leri değiştirmeyi unutmuşum birde kayıt sayfasında textboxlara aktarım kısmını düzelttim bu dosyayı indirirsiniz yukarıdakini indirmeyin.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
batur_00
Siteye Alışmış
 
Kayıt: 05 Ekm 2014 22:39
Meslek: tekstil işçisi
Yaş: 41
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa-Orhangazi

Önceki

Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Yandex[Bot] ve 1 misafir

Bumerang - Yazarkafe