Soru Demo

[horzum]

Sub kaydet()
Dim i As Integer
Dim kaydetmodu As String
Dim basliklar()
Dim degerler(50) As Variant

degerler(0) = UserForm1.Controls("TextBoxPerIDX").Value: If degerler(0) = "" Then Exit Sub
degerler(1) = UserForm1.Controls("TextBox1").Value
'Call DbAc

strlog = "Select personel.idx, personel.ad From personel Where personel.idx=" & degerler(0)

Set RS = CreateObject("ADODB.recordset")
RS.Open strlog, adoCN, 1 ', 3
'Set RS = adoCN.Execute(strlog)
If RS.RecordCount > 0 Then
sor = MsgBox("Var olan " & degerler(1) & " personel noya ait kayıt değiştirilecek." & Chr(10) & "Devam edeyim mi ?", vbYesNo + vbInformation + vbDefaultButton2, "Dikkat")
If sor = vbNo Then Exit Sub
kaydetmodu = "degistir"
End If
RS.Close
Set RS = Nothing

basliklar = Array("idx", "per_no", "ad", "soyad", "ilk_soyad", "tc_kimlik_no", "cinsiyet", "dogum_tarihi", "dogum_yeri", "baba_ad", "ana_ad", "ise_giris_tarihi", "is_cikis_tarihi", "hafta_tatili", "statu", "medeni_hali", "ssk_no", "dept", "gorev", "tahsil", "meslek", "ev_tel", "is_tel", "cep_tel", "eposta", "adres", "adres_il", "adres_ilce", "kan_grubu", "nfs_seri", "nfs_no", "nfs_kay_il", "nfs_kay_ilce", "nfs_kay_mah_koy", "cilt_no", "aile_sno", "sira_no", "aciklama")

For i = 2 To 37
Select Case i
Case 6, 13, 14, 15, 17, 18, 19, 28
degerler(i) = UserForm1.Controls("ComboBox" & i).Value
Case Else
degerler(i) = UserForm1.Controls("TextBox" & i)
End Select
Next i

If degerler(1) = "" Or degerler(2) = "" Or degerler(3) = "" Then MsgBox "Personel No, Adı ve Soyadı boş olamaz..": Exit Sub
If degerler(7) = "" Or degerler(11) = "" Then MsgBox "Doğum tarihi ve İşe Giriş tarihi boş olamaz..": Exit Sub
If degerler(14) = "" Or degerler(17) = "" Then MsgBox "Statü ve Bölüm boş olamaz..": Exit Sub

strlog = "Select personel.idx, personel.ad From personel Where personel.per_no='" & degerler(1) & "'"
Set RS = CreateObject("ADODB.recordset")
RS.Open strlog, adoCN, 1 ', 3
'Set RS = adoCN.Execute(strlog)
If RS.RecordCount > 0 Then
RS.MoveFirst
Do While Not RS.EOF
If RS("idx") <> Val(degerler(0)) Then MsgBox "Aynı Personel Numarası ile kayıtlı bir kişi var!": Exit Sub
RS.MoveNext
Loop
End If
RS.Close
Set RS = Nothing

If kaydetmodu = "degistir" Then
strSQL = "UPDATE personel SET " & "personel." & basliklar(1) & " = '" & degerler(1) & "'"
For i = 2 To 37
Select Case i
Case 7, 11, 12
If degerler(i) = "" Then
strSQL = strSQL & ", " & "personel." & basliklar(i) & " =NULL"
Else
strSQL = strSQL & ", " & "personel." & basliklar(i) & " = '" & degerler(i) & "'"
End If
Case Else
strSQL = strSQL & ", " & "personel." & basliklar(i) & " = '" & degerler(i) & "'"
End Select
Next i
strSQL = strSQL & " WHERE personel.idx=" & degerler(0)
Else
MsgBox "Demo versiyonda yeni personel kaydı yapılamamaktadır!", , "Horzum"
End If
'MsgBox strSQL
On Error Resume Next
adoCN.Execute (strSQL)
'Call DbKapat
End Sub

YUKARIDAKİ KOD'DA DEMO'YU İPTAL EDEMEDİM BİR TÜRLÜ YARDIMCI OLABİLECEK VARIMI

 

[yanginci34]

dosya yı gönderin bakalım

 

[horzum]

dosya yı gönderin bakalım

NASIL GÖNDERECEĞİM. GÖNDERMEK İÇİN SEÇENEK BULAMADIM

 

[yanginci34]

http://dosya.co/ gibi dosya yükleme sitelerine yükleyip link i buraya atın.

 

[Ömer BARAN]

Merhaba.
Sorularınızı örnek belge (cevabımın altındaki İMZA bölümünü okuyunuz) üzerinden sorarsanız daha hızlı sonuca ulaşabilirsiniz.

Ayrıca mesajlarınızda kod/formül eklemek için,
mesaj yazma alanının hemen üstünde yer alan ilgili bölümü (ekran görüntüsüe bakınız) kullanmanızda yarar var.
.

 

[horzum]

http://dosya.co/ gibi dosya yükleme sitelerine yükleyip link i buraya atın.

https://drive.google.com/file/d/1XbmreXGXDvGw9ofQQEQfbTbY6S7jmihw/view?usp=sharing

 

[horzum]

https://drive.google.com/file/d/1XbmreXGXDvGw9ofQQEQfbTbY6S7jmihw/view?usp=sharing

http://dosya.co/xx6uo4jxohxh/Personel.xlsm.html

 

[akoray2013]

Değiştirmeye çalıştığınız dosya ücretli satılan bir program.

Excel Çözümleri adlı siteden alınmış. Linki aşağıda

https://www.**********leri.com/tr/urunlerimiz/excelde-personel-izin-programi

 

[Ömer BARAN]

Ben de; "bu kodları bir yerden hatırlıyorum" diyordum.

Emeğe saygı lütfen.
.

 

[horzum]

bir blog sitesinden indirdim. vb herhangi bir kısıtlama olmayınca ve demo olunca üzerinde uğraştım yapamadım. o siteye ait herhangi bir iz yok ama

 

[Ömer BARAN]

Daha önce, aynı belge için, başka bir üye (mesajları silmediğim için bulabildim, adını burada yazmayayım şimdi) özel mesaj ile destek talep etmişti. Kodları (değişken adları/kodlama tarzı itibariyle) hatırlar gibi olmuştum.
Benim gördüğüm belge şifresiz idi ve ilgili üyeye aynen (kopyalayıp yapıştırdım) aşağıdaki cevabı vermişim.

Müellifini bilmiyorum ama, profesyonel bir ekibin (bence tek bir kişi değil) ürünü olduğu belli ve tam sürüm için ücretli destek/danışmanlık verilecek gibi görünüyor. Eklediğiniz belgede herhangi bir kısıtlama görmedim (VBA yönü şifresiz) ama yapılacak/düşünülecek değişikliklerin belgedeki diğer kodlara/belgeye/formlara/access veri tabanına etkilerini, ancak proje müellifi tam olarak bilebilir diye düşünüyorum.

 

[veyselemre]

Daha önce, aynı belge için, başka bir üye (mesajları silmediğim için bulabildim, adını burada yazmayayım şimdi) özel mesaj ile destek talep etmişti. Kodları (değişken adları/kodlama tarzı itibariyle) hatırlar gibi olmuştum.
Benim gördüğüm belge şifresiz idi ve ilgili üyeye aynen (kopyalayıp yapıştırdım) aşağıdaki cevabı vermişim.

Müellifini bilmiyorum ama, profesyonel bir ekibin (bence tek bir kişi değil) ürünü olduğu belli ve tam sürüm için ücretli destek/danışmanlık verilecek gibi görünüyor. Eklediğiniz belgede herhangi bir kısıtlama görmedim (VBA yönü şifresiz) ama yapılacak/düşünülecek değişikliklerin belgedeki diğer kodlara/belgeye/formlara/access veri tabanına etkilerini, ancak proje müellifi tam olarak bilebilir diye düşünüyorum.

Ömer Bey, Osmanlı arşivleri gibisiniz.

 

[Haluk]

Ömer Bey, Osmanlı arşivleri gibisiniz.

Süperdi .....

Çok yaşayın Veysel Bey .....


.

 

[Ömer BARAN]

Eyvallah, sağ olunuz.
Memuriyete verilmiş 27 yılın sonucu galiba.