DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Merhaba,
Dosyanız ilişiktedir.
Target.Next = deg(1)
Sayfaya ait kodlarda Target ibaresi en son işlem yapılan hücreyi sembolize eder.
Selamlar,
Sn. dEdE beyin önerdiği koddaki Cells(ActiveCell.Row - 1, 2) = deg(1) kod bloğunu aşağıdaki şekilde değiştirip denermisiniz.
Kod:Target.Next = deg(1)
Sayfaya ait kodlarda Target ibaresi en son işlem yapılan hücreyi sembolize eder.
Selamlar,
Sn. HD1975,
Ben sorunuzda KAPALI DOSYA şeklinde bir ibare göremedim. Lütfen sorularınızı açık bir dille ifade ediniz.
Cells(Target.Row , "H") = deg(1)
Selamlar,
Aşağıdaki şekilde kullanabilirsiniz.
Kod:Cells(Target.Row , "H") = deg(1)
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
deg = Split(Environ(28), "=")
Cells(Target.Row, [B][COLOR=red]"H"[/COLOR][/B]) = deg(1)
End Sub
Merhaba,
[/QUOTKod:Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, [A:A]) Is Nothing Then Exit Sub deg = Split(Environ(28), "=") Cells(Target.Row, [B][COLOR=red]"H"[/COLOR][/B]) = deg(1) End Sub
Sayın uzmanım,kod gayet güzel çalışıyor ama kapalıda iş görmüyor.
Göndermiş olduğum dosyaya dış bir kitaptan bazı notlar kaydediyorum.
1-Gönderiş olduğunuz kodu kapalı olan dosyanın sayfasına atıyorum ve kapatıyorum.
2-Veri girdiğim kitabı açıp not giriyorum ve kaydediyorum.
3-Tekrar kapalı dosyayı açıyorum ama notlar gelmiş kullanıcı adı yok.
4-Dede Bey'in yaptığı Activecell kodu ile kapalı iken yazdı,fakat onda bir sağdaki hücreye yazıyor ve mouse'u dikkate alıyor mouse hangi hücrede ise
onun bir üstüne yazıyor,dolayısıyla dosya kapalı iken bu mouse sorunu yüzünden rastgele yerlere yazıyor.
Saygılar
Selamlar,
Kapalı dosyaya verileri aktardığınız kodu verin yardımcı olalım.
Private Sub CommandButton1_Click()
Set con = CreateObject("adodb.connection")
If con.State = 1 Then con.Close
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & _
"\NOTLARIM.xls;extended properties=""excel 8.0;hdr=yes"""
Kullanıcı = Split(Environ(28), "=")
With Sayfa1
Set rs = CreateObject("adodb.recordset")
rs.Open "select * from [sayfa1$]", con, 1, 3
rs.addnew
rs("Kişi no") = .Range("b3").Value
rs("Adı") = .Range("b4").Value
rs("Adresi") = .Range("b6").Value
rs("Tel1") = .Range("b8").Value
rs("Tel2") = .Range("b9").Value
rs("Not") = .Range("b12").Value
rs("Randevu tarihi") = .Range("c12").Value
rs("İşlem tarihi") = .Range("d12").Value
rs("Kullanıcı") = Kullanıcı(1)
rs.Update
End With
On Local Error Resume Next
con.Close
Set con = Nothing
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
deg = Split(Environ(28), "=")
Cells(Target.Row, "H") = deg(1)
End Sub