VBA ile kilitlediğimde Hata Mesajı...

[maytro]

Merhaba,

VBA ile farklı dosyadan veri çekiyorum, lakin VBA ile hücre kilitlediğimde;
Range("K3").CopyFromRecordset Rs de hata alıyorum acaba sorun nedir?

Hata aldığım Kod;

Hücre Kilitleme Kodu;

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Object
ActiveSheet.Unprotect "123"
With Columns("K:V")
.Locked = False
.FormulaHidden = False
End With
Set LastRow = Sayfa1.Range("K104857:V104857").End(xlUp)
Columns("K:V").SpecialCells(xlCellTypeConstants, 23).Locked = True
şifre = "123"
ActiveSheet.Protect şifre
End Sub

 

[AdemCan]

Kilitli hücrelere veri yazdırmadan önce de ActiveSheet.Unprotect "123" ile sayfa korumasını kaldırmalısınız.

 

[maytro]

Kilitli hücrelere veri yazdırmadan önce de ActiveSheet.Unprotect "123" ile sayfa korumasını kaldırmalısınız.

Sanırım yapamadım :-( rica etsem dosya ya baka bilirmisiniz.?

 

[AdemCan]

Range("K3").CopyFromRecordset Rs satırı hücrelere veri yazdığı için, bu satırdan önce sayfa koruma şifresinin açılmış olması gerekiyor.

Sub VERİ()
    Dim Con As Object, Rs As Object, Sorgu As String
    Set Con = CreateObject("AdoDB.Connection")
    Set Rs = CreateObject("AdoDB.RecordSet")
   Con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & ThisWorkbook.Path & "\ISGB.xlsm" & _
    ";Extended Properties=""Excel 12.0;Hdr=yes"""
    Sorgu = "Select [HEYET RANDEVU TARİHİ],[İŞYERİ HEKİMİNE YÖNLENDİRME TARİHİ],[NOTLAR],[CEVAPLAR],[İK MÜDÜRLÜĞÜNÜN YAZDIĞI NOTLAR],[İSGB YAZI TARİHİ],[İSGB YAZI NO],[İŞYERİ HEKİM KARARI],[ÇALIŞAMAZ İSE NEDENİ],[İGU KARARI],[ÇALIŞAMAZ İSE NEDENİ],[BARKODLU E-NABIZ BELGE DURUMU] From [Sayfa1$K2:V10000]"
    Rs.Open Sorgu, Con, 1, 1
    
    ActiveSheet.Unprotect "123"
    
    Range("K3").CopyFromRecordset Rs
    
    Rs.Close: Con.Close
      
    ActiveSheet.Protect "123"
    End Sub

 

[maytro]

Range("K3").CopyFromRecordset Rs satırı hücrelere veri yazdığı için, bu satırdan önce sayfa koruma şifresinin açılmış olması gerekiyor.

Sub VERİ()
    Dim Con As Object, Rs As Object, Sorgu As String
    Set Con = CreateObject("AdoDB.Connection")
    Set Rs = CreateObject("AdoDB.RecordSet")
   Con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & ThisWorkbook.Path & "\ISGB.xlsm" & _
    ";Extended Properties=""Excel 12.0;Hdr=yes"""
    Sorgu = "Select [HEYET RANDEVU TARİHİ],[İŞYERİ HEKİMİNE YÖNLENDİRME TARİHİ],[NOTLAR],[CEVAPLAR],[İK MÜDÜRLÜĞÜNÜN YAZDIĞI NOTLAR],[İSGB YAZI TARİHİ],[İSGB YAZI NO],[İŞYERİ HEKİM KARARI],[ÇALIŞAMAZ İSE NEDENİ],[İGU KARARI],[ÇALIŞAMAZ İSE NEDENİ],[BARKODLU E-NABIZ BELGE DURUMU] From [Sayfa1$K2:V10000]"
    Rs.Open Sorgu, Con, 1, 1
   
    ActiveSheet.Unprotect "123"
   
    Range("K3").CopyFromRecordset Rs
   
    Rs.Close: Con.Close
     
    ActiveSheet.Protect "123"
    End Sub

Ne kadar Teşekkür etsem az size... Ellerinize sağlık....

 

[AdemCan]

Rica ederim, iyi çalışmalar.