SpreadSheet.WORKSHEETS(1) tanımlama problemi ve copyfromrecordset özelliği

H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
OWC11 dll e ait SpreadSheet.WORKSHEETS(1) tanımlama problemi ve copyfromrecordset özelliği

Aşağıdaki kodlamada adob sorgusunu spreadsheet nesnesinin bir indexnolu sayfasına vermekteyim.
kısaltma amacıyla nesneyi Dim sprCsf As Worksheet şeklinde tanımlayınca Set sprCsf = sprOkumalar.Worksheets(1) satırında type msitimach 13 hatası veriyor yani nesne bulunamadı tanımlamadan kullanabiliyorum, object olarak tanımlayınca nesnenin özellikleri açılan kutudan gelmiyor, bir çözümü var mı?

Ayrıca Spreadsheetnesnesinde normal çalışma sayfasında bulunan CopyFromRecordset özelliği yok yada kullanımı farklımı, denediğimde sadece kayıda ait ilk başlık bilgisini verdi.
Kod: 
      With CSfOzet
        .Cells.Clear
        .Range(.Cells(1, 1), .Cells(1, 3)).Value = Array("Sayac_No", "Adi_Soyadi", "Mevkii")
        .Range("a2").CopyFromRecordset adbKset
      End With

Kod: 
Sub adbKset_Tarihler_Aç()
  Set CSfData = CKtp_Bu.Sheets("DATA")     'Verilerin alınacağı sayfa.
  Dim sqlFrom$, sqlBasl$, sqlSorg$, sqlSatr$, sqlGrup$
[COLOR=Red]  Dim sprCsf As Worksheet[/COLOR]
'  Dim sprCsf As Spreadsheet.Worksheet
  
 '1\Adob RecordSet Sorgulama Kriterlerini hazırlıyoruz...
  sqlBasl = "SELECT DISTINCT " & "Tarihi, Aktif_Değeri, Reaktif_Değeri, Kapasitif_Değeri, Aciklama"
  sqlFrom = " FROM " & "[" & CSfData.Name & "$" & "A2:H1800" & "]"
  sqlSorg = " WHERE " & "Sayac_No = " & Me.ComboBox1.Column(0)                                      'Sayaç Numarası, Combobox1'e eşit olan kayıtlar
    sqlSorg = sqlSorg & " AND UCase(Adi_Soyadi) Like '" & UCase(Me.TextBox1.Text) & "'"    ' ve Adı soyadı,  textbox1'i içeren kayıtlar
    sqlSorg = sqlSorg & " AND Tarihi IS NOT NULL"
  sqlGrup = " GROUP BY  " & "Sayac_No, Adi_Soyadi, Mevkii, Tarihi, Aktif_Değeri,"
    sqlGrup = sqlGrup & " Reaktif_Değeri, Kapasitif_Değeri, Aciklama"
  sqlOrdr = " ORDER BY Tarihi DESC"
  sqlSatr = sqlBasl & sqlFrom & sqlSorg & sqlGrup & sqlOrdr
  
  '1\Adob RecordSet Sorgulamasını başlatıyoruz...
  If Err = 0 Then
    Set adbKset = CreateObject("ADODB.Recordset")
    With adbKset
      .ActiveConnection = adbBagl
      .CursorLocation = adUseServer
      .CursorType = adOpenKeyset
      .LockType = adLockOptimistic
      .Source = sqlSatr
      .Open
      '***********************************************************************
      Label15.Caption = Space(5) & .RecordCount & " Adet Okuma Kaydı bulundu"
     
      '2\Spreadsheet Nesnesinin 1 nolu çalışma sayfasını Sorgu Sonuçları için hazırlıyoruz.
      Set sprCsf = sprOkumalar.Worksheets(1)
      With sprCsf
        .Cells.Clear
        With .Columns("A")
          .HorizontalAlignment = xlRight
          .ColumnWidth = 10
          .NumberFormat = "dd/mm/yyyy;@"
        End With
        With .Columns("B:D")
          .HorizontalAlignment = xlRight
          .ColumnWidth = 12
          .NumberFormat = "#,##0.0000"
        End With
        With .Columns("E")
          .HorizontalAlignment = xlLeft
          .ColumnWidth = 50
        End With
        With .Rows(1)
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
          .RowHeight = 25
        End With
      End With
      
      '1\\Bulunan Kayıt Sayısı 0 dan fazla ise...
      If .RecordCount > 0 Then
        '1\\\Sorgu Başlıklarını 1. satıra yazıyoruz.
        For fldCount = 0 To .Fields.Count - 1
          intIRow = intIRow + 1
          sprCsf.Cells(1, intIRow).Value = Replace(.Fields(fldCount).Name, "_", " ")
        Next
        '1\\\Sorgu sonuçlarını sprCsf'ye 2. satırdan itibaren yazıyoruz.
[COLOR=Red]        sat = 1:         .MoveFirst
        For i = 1 To .RecordCount
          sprCsf.Cells(sat + i, 1).Value = .Fields(0)
          sprCsf.Cells(sat + i, 2).Value = .Fields(1)
          sprCsf.Cells(sat + i, 3).Value = .Fields(2)
          sprCsf.Cells(sat + i, 4).Value = .Fields(3)
          sprCsf.Cells(sat + i, 5).Value = .Fields(4)
          .MoveNext
        Next i
        .MoveFirst[/COLOR]
      End If '.RecordCount > 0 Then
    End With
  Else
    MsgBox "Bağlantı Hatası Kontrol Ediniz", vbInformation, "Bilgi"
  End If
  '1\Adob RecordSet Sorgulamasını sonlandırıyoruz.
  With adbKset
    If CBool(.State And adStateOpen) = True Then .Close:  Set adbKset = Nothing
  End With
End Sub
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Sizin yaptığınız değişken tanımlaması Excel Application'ına özeldir. Yani
"Dim sprCsf As Worksheet" demekle, bir Excel Worksheet nesne değişkeni tanımlıyorsunuz. Oysa ki; bu worksheet OWC nesnesine ait bir sheet ise; bu durumda

Kod: 
Dim sprCsf as OWC11.Worksheet
şeklinde tanımlamalı ve

Kod: 
Set sprCsf=SprOkulamalar.WorkSheets(1)
şeklinde set etmelisiniz.

Ayrıca, CopyFromRecordset, kodlarda doğru kullanılmış, bir hata olmaması gerekiyor.
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Hocam alakanıza teşekkür ederim dediğiniz gibi başına OWC koyunca düzeldi, ben spreadshett koyup bile denemiştim ama aklıma OWC11 koymak gelmedi. :)

copyfromRecordset özelliğine gelince, sorun aynen devam ediyor... ekran alıntısı aşağıdaki gibidir;


kodlar;
Kod: 
Sub adbKset_Tarihler_Aç()
  Set CSfData = CKtp_Bu.Sheets("DATA")     'Verilerin alınacağı sayfa.
  Dim sqlFrom$, sqlBasl$, sqlSorg$, sqlSatr$, sqlGrup$
  Dim sprCsf As OWC11.Worksheet
  
 '1\Adob RecordSet Sorgulama Kriterlerini hazırlıyoruz...
  sqlBasl = "SELECT DISTINCT " & "Tarihi, Aktif_Değeri, Reaktif_Değeri, Kapasitif_Değeri, Aciklama"
  sqlFrom = " FROM " & "[" & CSfData.Name & "$" & "A2:H1800" & "]"
  sqlSorg = " WHERE " & "Sayac_No = " & Me.ComboBox1.Column(0)                                      'Sayaç Numarası, Combobox1'e eşit olan kayıtlar
    sqlSorg = sqlSorg & " AND UCase(Adi_Soyadi) Like '" & UCase(Me.TextBox1.Text) & "'"    ' ve Adı soyadı,  textbox1'i içeren kayıtlar
    sqlSorg = sqlSorg & " AND Tarihi IS NOT NULL"
  sqlGrup = " GROUP BY  " & "Sayac_No, Adi_Soyadi, Mevkii, Tarihi, Aktif_Değeri,"
    sqlGrup = sqlGrup & " Reaktif_Değeri, Kapasitif_Değeri, Aciklama"
  sqlOrdr = " ORDER BY Tarihi DESC"
  sqlSatr = sqlBasl & sqlFrom & sqlSorg & sqlGrup & sqlOrdr
  
  '1\Adob RecordSet Sorgulamasını başlatıyoruz...
  If Err = 0 Then
    Set adbKset = CreateObject("ADODB.Recordset")
    With adbKset
      .ActiveConnection = adbBagl
      .CursorLocation = adUseServer
      .CursorType = adOpenKeyset
      .LockType = adLockOptimistic
      .Source = sqlSatr
      .Open
      '***********************************************************************
      Label15.Caption = Space(5) & .RecordCount & " Adet Okuma Kaydı bulundu"
     
      '2\Spreadsheet Nesnesinin 1 nolu çalışma sayfasını Sorgu Sonuçları için hazırlıyoruz.
      sprOkumalar.Worksheets(1).Activate
      Set sprCsf = sprOkumalar.ActiveSheet
      'sprOkumalar.ActiveSheet.Unprotect
      
      With sprCsf
        .Unprotect
        .Cells.Clear
        With .Columns("A")
          .HorizontalAlignment = xlRight
          .ColumnWidth = 10
          .NumberFormat = "dd/mm/yyyy;@"
        End With
        With .Columns("B:D")
          .HorizontalAlignment = xlRight
          .ColumnWidth = 12
          .NumberFormat = "#,##0.0000"
        End With
        With .Columns("E")
          .HorizontalAlignment = xlLeft
          .ColumnWidth = 50
        End With
        With .Rows(1)
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
          .RowHeight = 25
        End With
      End With
      
      '1\\Bulunan Kayıt Sayısı 0 dan fazla ise...
      If .RecordCount > 0 Then
        '1\\\Sorgu Başlıklarını 1. satıra yazıyoruz.
        For fldCount = 0 To .Fields.Count - 1
          intIRow = intIRow + 1
          sprCsf.Cells(1, intIRow).Value = Replace(.Fields(fldCount).Name, "_", " ")
        Next
        '1\\\Sorgu sonuçlarını sprCsf'ye 2. satırdan itibaren yazıyoruz.
'ben döngüye girmeden direkt A2 den yapıştırsın diyorum ama yapıştırmıyor.
       [B][COLOR=Red] sprCsf.Range("a2").CopyFromRecordset adbKset[/COLOR][/B]

        
[COLOR=SeaGreen]'Aşağıdaki kod bloğu döngü ile yazıyor... veri azken sorun yok çoğaldığı zaman uzamasın istiyorum.
        
'        sat = 1:         .MoveFirst
'        For i = 1 To .RecordCount
'          sprCsf.Cells(sat + i, 1).Value = .Fields(0)
'          sprCsf.Cells(sat + i, 2).Value = .Fields(1)
'          sprCsf.Cells(sat + i, 3).Value = .Fields(2)
'          sprCsf.Cells(sat + i, 4).Value = .Fields(3)
'          sprCsf.Cells(sat + i, 5).Value = .Fields(4)
'          .MoveNext
'        Next i
'        .MoveFirst[/COLOR]
        sprCsf.Protect
      End If '.RecordCount > 0 Then
    End With
  Else
    MsgBox "Bağlantı Hatası Kontrol Ediniz", vbInformation, "Bilgi"
  End If
  '1\Adob RecordSet Sorgulamasını sonlandırıyoruz.
  With adbKset
    If CBool(.State And adStateOpen) = True Then .Close:  Set adbKset = Nothing
  End With
End Sub
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Üst