Cari hareket listesini Excelden alin

Forumun katkilariyla: Netsis cari hareket listesini Excel den alabiliyoruz. Türkçe karakterler problemi çok ugrastirdi, ama ugrasinca çözüm bulunabiliyor. Su an en basit hali, artik yavas yavas gelistirelim ve paylasalim, paylasinca güzel oluyor degil mi?....

Sub Sayfa12_Dügme1_Tiklat()
Dim conn As New ADODB.Connection
    Dim kyt As New ADODB.Recordset
    Dim sql As String
    Dim bakiye As Double

 With conn
    .Provider = "sqloledb"
    .CommandTimeout = 120
    .ConnectionString = "Data Source=" & Sayfa12.Cells(1,10).Value & ";USER ID=" & Sayfa1.Cells(1, 11).Value & ";PASSWORD=" & Sayfa1.Cells(1, 12).Value & ";AUTO TRANSLATE=FALSE"
    .Open
    .DefaultDatabase = Sayfa12.Textbox1.Text
    End With

    sql = "SELECT    * FROM TBLCAHAR "
    sql = sql + " WHERE CARI_KOD = ('" + esctrk(Sayfa12.Cells(2, 1)) + "')"
    sql = sql + " ORDER BY TARIH ASC   "
    kyt.Open sql, conn, adOpenStatic, adLockReadOnly
    Sayfa12.Range("B5:Z10000").ClearContents
    Sayfa12.Activate
    j = 5
    For x = 0 To 9
    Sayfa12.Cells(j, x + 2).Value = kyt(x).Name
    Next x

    bakiye = 0

    i = 6
    Do While Not kyt.EOF
        Sayfa12.Cells(1, 1).Value = i + 1

        For y = 0 To 9

        Sayfa12.Cells(i, y + 2).Value = kyt(y)

        Next y

        bakiye = bakiye + Sayfa12.Cells(i, 9).Value - Sayfa12.Cells(i, 10).Value
        Sayfa12.Cells(i, y + 1).Value = bakiye

        kyt.MoveNext
        i = i + 1
    Loop

    kyt.Close
    conn.Close
    Set kyt = Nothing
    Set conn = Nothing
End Sub

Private Sub ListBox1_Click()
Sayfa12.Cells(2, 1).Value = ListBox1.Text

End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim conn As New ADODB.Connection
    Dim kyt As New ADODB.Recordset
    Dim Sql As String
    Dim bakiye As Double

 With conn
    .Provider = "sqloledb"
    .CommandTimeout = 120
    .ConnectionString = "Data Source=" & Sayfa12.Cells(1,10).Value & ";USER ID=" & Sayfa1.Cells(1, 11).Value & ";PASSWORD=" & Sayfa1.Cells(1, 12).Value & ";AUTO TRANSLATE=FALSE"
    .Open
    .DefaultDatabase = Sayfa12.Textbox1.Text
    End With

    Sql = "SELECT CARI_KOD, CARI_ISIM    FROM TBLCASABIT "
    Sql = Sql + " ORDER BY CARI_KOD ASC   "
    kyt.Open Sql, conn, adOpenStatic, adLockReadOnly
      i = 0
       Do While Not kyt.EOF
       Sayfa12.ListBox1.AddItem kyt(0)
       Sayfa12.ListBox1.List(i, 1) = kyt(1) & ""
       kyt.MoveNext
       i = i + 1
    Loop

     kyt.Close
    conn.Close
    Set kyt = Nothing
    Set conn = Nothing
End Sub

Public Function esctrk(gstr)
    Dim geri As String
    geri = gstr
    geri = Replace(geri, "G", Sayfa12.Cells(1048576, 3))
    geri = Replace(geri, "S", Sayfa12.Cells(1048576, 1))
    geri = Replace(geri, "I", Sayfa12.Cells(1048576, 2))

    esctrk = geri
End Function

Düzenleyen hbulus - 16 Temmuz 2008 Saat 13:37

Yazar	Mesaj Konu Arama Topic Seçenekleri Yanıt Yaz Yeni Konu Oluştur Konuyu Yazdır Çeviri Konu
hbulus Üye Profili Özel Mesaj Yolla Üye mesajı bul Arkadaş Listeme Ekle Üye Kayıt Tarihi: 26 Aralık 2007 Durum: Aktif Değil Puanlar: 15	Mesaj Seçenekleri Yanıt Yaz Alıntı hbulus Bu mesaj kurallara aykırıysa buradan yöneticileri bilgilendirebilirsiniz. Teşekkürler(0) Alıntı Cevapla Konu: Cari hareket listesini Excelden alin Gönderim Zamanı: 16 Temmuz 2008 Saat 12:58
	Forumun katkilariyla: Netsis cari hareket listesini Excel den alabiliyoruz. Türkçe karakterler problemi çok ugrastirdi, ama ugrasinca çözüm bulunabiliyor. Su an en basit hali, artik yavas yavas gelistirelim ve paylasalim, paylasinca güzel oluyor degil mi?.... Sub Sayfa12_Dügme1_Tiklat() Dim conn As New ADODB.Connection Dim kyt As New ADODB.Recordset Dim sql As String Dim bakiye As Double With conn .Provider = "sqloledb" .CommandTimeout = 120 .ConnectionString = "Data Source=" & Sayfa12.Cells(1,10).Value & ";USER ID=" & Sayfa1.Cells(1, 11).Value & ";PASSWORD=" & Sayfa1.Cells(1, 12).Value & ";AUTO TRANSLATE=FALSE" .Open .DefaultDatabase = Sayfa12.Textbox1.Text End With sql = "SELECT * FROM TBLCAHAR " sql = sql + " WHERE CARI_KOD = ('" + esctrk(Sayfa12.Cells(2, 1)) + "')" sql = sql + " ORDER BY TARIH ASC " kyt.Open sql, conn, adOpenStatic, adLockReadOnly Sayfa12.Range("B5:Z10000").ClearContents Sayfa12.Activate j = 5 For x = 0 To 9 Sayfa12.Cells(j, x + 2).Value = kyt(x).Name Next x bakiye = 0 i = 6 Do While Not kyt.EOF Sayfa12.Cells(1, 1).Value = i + 1 For y = 0 To 9 Sayfa12.Cells(i, y + 2).Value = kyt(y) Next y bakiye = bakiye + Sayfa12.Cells(i, 9).Value - Sayfa12.Cells(i, 10).Value Sayfa12.Cells(i, y + 1).Value = bakiye kyt.MoveNext i = i + 1 Loop kyt.Close conn.Close Set kyt = Nothing Set conn = Nothing End Sub Private Sub ListBox1_Click() Sayfa12.Cells(2, 1).Value = ListBox1.Text End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim conn As New ADODB.Connection Dim kyt As New ADODB.Recordset Dim Sql As String Dim bakiye As Double With conn .Provider = "sqloledb" .CommandTimeout = 120 .ConnectionString = "Data Source=" & Sayfa12.Cells(1,10).Value & ";USER ID=" & Sayfa1.Cells(1, 11).Value & ";PASSWORD=" & Sayfa1.Cells(1, 12).Value & ";AUTO TRANSLATE=FALSE" .Open .DefaultDatabase = Sayfa12.Textbox1.Text End With Sql = "SELECT CARI_KOD, CARI_ISIM FROM TBLCASABIT " Sql = Sql + " ORDER BY CARI_KOD ASC " kyt.Open Sql, conn, adOpenStatic, adLockReadOnly i = 0 Do While Not kyt.EOF Sayfa12.ListBox1.AddItem kyt(0) Sayfa12.ListBox1.List(i, 1) = kyt(1) & "" kyt.MoveNext i = i + 1 Loop kyt.Close conn.Close Set kyt = Nothing Set conn = Nothing End Sub Public Function esctrk(gstr) Dim geri As String geri = gstr geri = Replace(geri, "G", Sayfa12.Cells(1048576, 3)) geri = Replace(geri, "S", Sayfa12.Cells(1048576, 1)) geri = Replace(geri, "I", Sayfa12.Cells(1048576, 2)) esctrk = geri End Function Düzenleyen hbulus - 16 Temmuz 2008 Saat 13:37

Conari Üye Profili Özel Mesaj Yolla Üye mesajı bul Arkadaş Listeme Ekle Kidemli Üye Kayıt Tarihi: 04 Mayıs 2007 Konum: YSTANBUL Durum: Aktif Değil Puanlar: 3513	Mesaj Seçenekleri Yanıt Yaz Alıntı Conari Bu mesaj kurallara aykırıysa buradan yöneticileri bilgilendirebilirsiniz. Teşekkürler(0) Alıntı Cevapla Gönderim Zamanı: 17 Temmuz 2008 Saat 08:59
	Belge yi ekleseydin keske de en azindan ListBox1, TExtbox lar ile biz ugrasmasaydik.
	Netsisden vazgeçemiyorum. Beni engelliyor..

jung Üye Profili Özel Mesaj Yolla Üye mesajı bul Arkadaş Listeme Ekle Üye Kayıt Tarihi: 01 Haziran 2007 Konum: Kocaeli Durum: Aktif Değil Puanlar: 13	Mesaj Seçenekleri Yanıt Yaz Alıntı jung Bu mesaj kurallara aykırıysa buradan yöneticileri bilgilendirebilirsiniz. Teşekkürler(0) Alıntı Cevapla Gönderim Zamanı: 18 Temmuz 2008 Saat 08:26
	selam dostum bu kodlari nereye yazacagiz nasil dügme yapacagiz?

hbulus Üye Profili Özel Mesaj Yolla Üye mesajı bul Arkadaş Listeme Ekle Üye Kayıt Tarihi: 26 Aralık 2007 Durum: Aktif Değil Puanlar: 15	Mesaj Seçenekleri Yanıt Yaz Alıntı hbulus Bu mesaj kurallara aykırıysa buradan yöneticileri bilgilendirebilirsiniz. Teşekkürler(0) Alıntı Cevapla Gönderim Zamanı: 18 Temmuz 2008 Saat 11:19
	Cehaletimi mazur görün ama ; dosya eklemeyi nereden yapacagimi bulamadigim için dosyayi size gönderemiyorum....! Bi el atinda su isi ögrenelim.

Conari Üye Profili Özel Mesaj Yolla Üye mesajı bul Arkadaş Listeme Ekle Kidemli Üye Kayıt Tarihi: 04 Mayıs 2007 Konum: YSTANBUL Durum: Aktif Değil Puanlar: 3513	Mesaj Seçenekleri Yanıt Yaz Alıntı Conari Bu mesaj kurallara aykırıysa buradan yöneticileri bilgilendirebilirsiniz. Teşekkürler(0) Alıntı Cevapla Gönderim Zamanı: 18 Temmuz 2008 Saat 11:55
	Dosya ekleme sitede yok. bir upload sitesine yükleyip link vermelisiniz.
	Netsisden vazgeçemiyorum. Beni engelliyor..

hbulus Üye Profili Özel Mesaj Yolla Üye mesajı bul Arkadaş Listeme Ekle Üye Kayıt Tarihi: 26 Aralık 2007 Durum: Aktif Değil Puanlar: 15	Mesaj Seçenekleri Yanıt Yaz Alıntı hbulus Bu mesaj kurallara aykırıysa buradan yöneticileri bilgilendirebilirsiniz. Teşekkürler(0) Alıntı Cevapla Gönderim Zamanı: 18 Temmuz 2008 Saat 12:39
	Dosyayi ekledim. Yalniz asagidaki fonksiyonu sql server da çalistiginiz sirket database'ine eklemezseniz hata alirsiniz. Fonksiyon; CREATE FUNCTION [dbo].[W2NTRK](@A NVARCHAR(4000)) RETURNS NVARCHAR(4000) AS BEGIN DECLARE @TMP NVARCHAR(4000) SET @TMP = REPLACE(@A , N'~G', N'Ð') --G (SQL'de yumusak G görüntüsü SET @TMP = REPLACE(@TMP , N'~S', N'Þ') --S (SQL'de S görüntüsü SET @TMP = REPLACE(@TMP , N'~I', N'Ý') --I (SQL'de I harfi görüntüsü SET @TMP = REPLACE(@TMP , N'~g', N'ð') --g SET @TMP = REPLACE(@TMP , N'~s', N'þ') --s SET @TMP = REPLACE(@TMP , N'~i', N'ý') --i RETURN @TMP END Ya da, Sql = Sql + " WHERE CARI_KOD = .dbo.W2NTRK('" + esctrk(Sayfa1.Cells(2, 1)) + "')" satirini Sql = Sql + " WHERE CARI_KOD = ('" + esctrk(Sayfa1.Cells(2, 1)) + "')" seklinde kullanirsaniz "S" ve "I" harfleri içeren sorgularda sonuç alamazsiniz. Excel dosyasi; http://rapidshare.com/files/130585795/Cari_Hareket_Listesi1.xls.html Düzenleyen hbulus - 18 Temmuz 2008 Saat 12:46

dbicer83 Üye Profili Özel Mesaj Yolla Üye mesajı bul Arkadaş Listeme Ekle Üye Kayıt Tarihi: 09 Nisan 2016 Konum: ank Durum: Aktif Değil Puanlar: 100	Mesaj Seçenekleri Yanıt Yaz Alıntı dbicer83 Bu mesaj kurallara aykırıysa buradan yöneticileri bilgilendirebilirsiniz. Teşekkürler(0) Alıntı Cevapla Gönderim Zamanı: 28 Ağustos 2016 Saat 09:48
	Selamlar Bu sekilde bir uygulamaya ihtiyacim var. Dosya eki ekleyebilecek var mi. Yada mail dbicer83@hotmail.com Çok tesekkürler