buton atama

S

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
186
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
merhaba; iyi akşamlar böyle bir sql kodum var ama excele buton olarak atayıp çalıştırmak isityorum falar uyarlayamadım. excelimde sql bağlantım mevcut. msql programında çalıştırınca sorun yok. vba bilgim olmadığı için uyarlayamadım desteğinizi bekliyorum. şimdiden teşekkürler

Kod: 
SELECT
ANATABLO.STOK_KODU
,ANATABLO.STOK_ADI
,ANATABLO.URETICI_KODU
,ANATABLO.BAKIYE
,ANATABLO.MINBAKIYE
--,URETICI_COUNT = (SELECT COUNT(*) FROM TBLSTSABIT WHERE URETICI_KODU = ANATABLO.URETICI_KODU)
FROM
  (
        SELECT
        X.STOK_KODU
        ,X.STOK_ADI
        ,X.URETICI_KODU
        ,BAKIYE = ISNULL((SELECT SUM(CASE WHEN Z.STHAR_gCKOD='G' THEN Z.STHAR_GCMIK ELSE -Z.STHAR_GCMIK END ) FROM TBLSTHAR Z WHERE Z.STOK_KODU = X.STOK_KODU AND Z.DEPO_KODU='2'),0)
        ,
        MINBAKIYE=
        (
                
                SELECT
                MIN(AA)
                FROM
                (
                SELECT

                SA.STOK_KODU
                ,SA.STOK_ADI
                ,SA.URETICI_KODU,
                AA=
                
                        (ISNULL((
                        SELECT
                        SUM(CASE WHEN HAR.STHAR_GCKOD='G' THEN HAR.STHAR_GCMIK ELSE -HAR.STHAR_GCMIK END) FROM TBLSTHAR HAR WHERE HAR.STOK_KODU = SA.STOK_KODU)
                        ,0))


                        ----

                        ---
                        FROM
                        TBLSTSABIT SA 
                        WHERE SA.URETICI_KODU = X.URETICI_KODU

                ) Y

        )
        FROM
        TBLSTSABIT X
        ---WHERE X.URETICI_KODU='004-08-18'
) ANATABLO
WHERE
 ISNULL(ANATABLO.BAKIYE,0)<> ISNULL(ANATABLO.MINBAKIYE,0) AND
ISNULL((SELECT COUNT(*) FROM TBLSTSABIT WHERE URETICI_KODU = ANATABLO.URETICI_KODU),0) > 1
 
S

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
186
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
bu şekilde uyarlamaya çalıştım fakat hata alıyorum üstadlardan destek bekliyorum. tşk


Kod: 
SqlText = "SELECT "
SqlText = SqlText + "ANATABLO.STOK_KODU"
SqlText = SqlText + ",ANATABLO.STOK_ADI"
SqlText = SqlText + ",ANATABLO.URETICI_KODU"
SqlText = SqlText + ",ANATABLO.BAKIYE"
SqlText = SqlText + ",ANATABLO.MINBAKIYE"
SqlText = SqlText + "--,URETICI_COUNT = (SELECT COUNT(*) FROM TBLSTSABIT WHERE URETICI_KODU = ANATABLO.URETICI_KODU)"
SqlText = SqlText + "FROM"
SqlText = SqlText + " ("
SqlText = SqlText + "       SELECT"""
SqlText = SqlText + "       X.STOK_KODU"
SqlText = SqlText + "       ,X.STOK_ADI"
SqlText = SqlText + "       ,X.URETICI_KODU"
SqlText = SqlText + "       ,BAKIYE = ISNULL((SELECT SUM(CASE WHEN Z.STHAR_gCKOD='G' THEN Z.STHAR_GCMIK ELSE -Z.STHAR_GCMIK END ) FROM TBLSTHAR Z WHERE Z.STOK_KODU = X.STOK_KODU AND Z.DEPO_KODU='2'),0)"
SqlText = SqlText + "       ,"
SqlText = SqlText + "       MINBAKIYE="
SqlText = SqlText + "       ("
              
SqlText = SqlText + "              SELECT"
SqlText = SqlText + "               Min (AA)"
SqlText = SqlText + "               FROM"
SqlText = SqlText + "              ("
SqlText = SqlText + "              SELECT"

SqlText = SqlText + "              SA.STOK_KODU"
SqlText = SqlText + "              ,SA.STOK_ADI"
SqlText = SqlText + "             ,SA.URETICI_KODU,"
SqlText = SqlText + "            AA="
              
SqlText = SqlText + "                    (ISNULL(("
SqlText = SqlText + "                    SELECT"
SqlText = SqlText + "                    SUM(CASE WHEN HAR.STHAR_GCKOD='G' THEN HAR.STHAR_GCMIK ELSE -HAR.STHAR_GCMIK END) FROM TBLSTHAR HAR WHERE HAR.STOK_KODU = SA.STOK_KODU)"
SqlText = SqlText + "                    ,0))"


 SqlText = SqlText + "                       ----"

  SqlText = SqlText + "                      ---"
SqlText = SqlText + "                     FROM"
SqlText = SqlText + "                     TBLSTSABIT SA"
SqlText = SqlText + "                     WHERE SA.URETICI_KODU = X.URETICI_KODU"

SqlText = SqlText + "            ) Y"

SqlText = SqlText + "       )"
SqlText = SqlText + "       FROM"
SqlText = SqlText + "        TBLSTSABIT X"
SqlText = SqlText + "       ---WHERE X.URETICI_KODU='004-08-18'"
SqlText = SqlText + ") ANATABLO"
SqlText = SqlText + "WHERE"
SqlText = SqlText + "ISNULL(ANATABLO.BAKIYE,0)<> ISNULL(ANATABLO.MINBAKIYE,0) AND"
SqlText = SqlText + "ISNULL((SELECT COUNT(*) FROM TBLSTSABIT WHERE URETICI_KODU = ANATABLO.URETICI_KODU),0) > 1"




 rs.Open SqlText, conn, adOpenStatic, adLockReadOnly
  
    Sayfa8.Range("A8:z80000").ClearContents
    Sayfa8.Activate
  
    i = 8
    X = 8
    Z = 8
    Y = 8
 
  
    Do While Not rs.EOF

        Sayfa8.Cells(i, 1).Value = rs(0)
        Sayfa8.Cells(i, 2).Value = rs(1)
        Sayfa8.Cells(i, 3).Value = rs(2)
        Sayfa8.Cells(i, 4).Value = rs(3)
        Sayfa8.Cells(i, 5).Value = rs(4)
'        Sayfa8.Cells(i, 6).Value = rs(5)
'        Sayfa8.Cells(i, 7).Value = rs(6)
'        Sayfa8.Cells(i, 8).Value = rs(7)
'        Sayfa8.Cells(i, 9).Value = rs(8)
'        Sayfa8.Cells(i, 10).Value = rs(9)
'    Sayfa8.Cells(i, 11).Value = rs(10)
' Sayfa8.Cells(i, 12).Value = rs(11)
'      Sayfa8.Cells(i, 13).Value = rs(12)
'      Sayfa8.Cells(i, 14).Value = rs(13)
'       Sayfa8.Cells(i, 15).Value = rs(14)
'       Sayfa8.Cells(i, 16).Value = rs(15)
'      Sayfa8.Cells(i, 17).Value = rs(16)
'      Sayfa8.Cells(i, 18).Value = rs(17)
'      Sayfa8.Cells(i, 19).Value = rs(18)
'      Sayfa8.Cells(i, 20).Value = rs(19)
      

         rs.MoveNext
         i = i + 1
    Loop
  

  
  
  
  

  
    '''''''''''''''''''
    conn.Close
    Set rs = Nothing
    Set conn = Nothing

Application.Calculation = xlAutomatic
 
Range("A8").Select

MsgBox "İşlem Tamamlandı", vbInformation, "Sonuç"
 

Ekli dosyalar

M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
559
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
1- Aşağıdaki kodu kullanarak veritabanına bağlantınız tanımlayın
Const strConn As String = "DRIVER={SQL Server Native Client 11.0};SERVER=SUNUCU_ADINIZ;DATABASE=VERİTABANI_ADINIZ;UID=KULLANICI_ADINIZ;PWD=ŞİFRENİZ;"

2-Modülünüzde, düğmeye tıklandığında çağrılacak bir fonksiyon oluşturun

Sub SQLiÇalıştır_Tıklamada()

Dim conn As Object
Dim rs As Object
Dim SqlText As String

On Error GoTo HataYöneticisi

Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = strConn

SqlText = "SELECT " & _
"ANATABLO.STOK_KODU, " & _
"ANATABLO.STOK_ADI, " & _
"ANATABLO.URETICI_KODU, " & _
"ANATABLO.BAKIYE, " & _
"ANATABLO.MINBAKIYE, " & _
"[...]" Kalan sutunları ve kodları buraya yazın

Set rs = conn.Execute(SqlText)

Sayfa8.Range("A8:Z80000").ClearContents

i = 8
Do While Not rs.EOF
Sayfa8.Cells(i, 1).Value = rs(0)
Sayfa8.Cells(i, 2).Value = rs(1)
Sayfa8.Cells(i, 3).Value = rs(2)
Sayfa8.Cells(i, 4).Value = rs(3)
Sayfa8.Cells(i, 5).Value = rs(4)

i = i + 1
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing

MsgBox "İşlem Tamamlandı", vbInformation, "Sonuç"

Exit Sub

HataYöneticisi:
MsgBox Err.Description, vbExclamation, "Hata!"

End Sub

Düğmenin bulunduğu Excel çalışma sayfasına geri dönün.
Düğmeye sağ tıklayın ve Makro Ata seçeneğini seçin.
Listeden SQLiÇalıştır_Tıklamada fonksiyonunu seçin ve Tamam'a tıklayın.
 
S

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
186
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
muhasebeciyiz' Alıntı:
1- Aşağıdaki kodu kullanarak veritabanına bağlantınız tanımlayın
Const strConn As String = "DRIVER={SQL Server Native Client 11.0};SERVER=SUNUCU_ADINIZ;DATABASE=VERİTABANI_ADINIZ;UID=KULLANICI_ADINIZ;PWD=ŞİFRENİZ;"

2-Modülünüzde, düğmeye tıklandığında çağrılacak bir fonksiyon oluşturun

Sub SQLiÇalıştır_Tıklamada()

Dim conn As Object
Dim rs As Object
Dim SqlText As String

On Error GoTo HataYöneticisi

Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = strConn

SqlText = "SELECT " & _
"ANATABLO.STOK_KODU, " & _
"ANATABLO.STOK_ADI, " & _
"ANATABLO.URETICI_KODU, " & _
"ANATABLO.BAKIYE, " & _
"ANATABLO.MINBAKIYE, " & _
"[...]" Kalan sutunları ve kodları buraya yazın

Set rs = conn.Execute(SqlText)

Sayfa8.Range("A8:Z80000").ClearContents

i = 8
Do While Not rs.EOF
Sayfa8.Cells(i, 1).Value = rs(0)
Sayfa8.Cells(i, 2).Value = rs(1)
Sayfa8.Cells(i, 3).Value = rs(2)
Sayfa8.Cells(i, 4).Value = rs(3)
Sayfa8.Cells(i, 5).Value = rs(4)

i = i + 1
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing

MsgBox "İşlem Tamamlandı", vbInformation, "Sonuç"

Exit Sub

HataYöneticisi:
MsgBox Err.Description, vbExclamation, "Hata!"

End Sub

Düğmenin bulunduğu Excel çalışma sayfasına geri dönün.
Düğmeye sağ tıklayın ve Makro Ata seçeneğini seçin.
Listeden SQLiÇalıştır_Tıklamada fonksiyonunu seçin ve Tamam'a tıklayın.
Genişletmek için tıkla ...
tüm satırların başına " tırnak sonuna " & _ şelindemi yapmalıyım. yoka kalan kodları direk yapıştırmalıyım. tüm satırların başına ve sonuna ekledim fakat olmadı. desteğiniz için teşekkürler bilgi verirseniz sevinirim.
 
S

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
186
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
bu şekilde fdüzenledim ama aşağıdaki görseldeki gibi haa verdi.


SqlText = "SELECT X.STOK_KODU " & _
",X.STOK_ADI " & _
",X.URETICI_KODU " & _
",BAKIYE = (( " & _
"SELECT SUM(CASE WHEN Z.STHAR_gCKOD='G' THEN Z.STHAR_GCMIK ELSE -Z.STHAR_GCMIK END IS NULL) " & _
"FROM TBLSTHAR Z " & _
"WHERE Z.STOK_KODU = X.STOK_KODU " & _
"AND Z.DEPO_KODU='2') ,0) " & _
",MINBAKIYE= ( " & _
"SELECT MIN(AA) " & _
"FROM ( " & _
"SELECT SA.STOK_KODU ,SA.STOK_ADI ,SA.URETICI_KODU, AA= ((( " & _
"SELECT SUM(CASE WHEN HAR.STHAR_GCKOD='G' THEN HAR.STHAR_GCMIK ELSE -HAR.STHAR_GCMIK END IS NULL) " & _
"FROM TBLSTHAR HAR " & _
"WHERE HAR.STOK_KODU = SA.STOK_KODU) ,0)) ---- --- " & _
"FROM TBLSTSABIT SA " & _
"WHERE SA.URETICI_KODU = X.URETICI_KODU ) Y ) " & _
"FROM TBLSTSABIT X --- " & _
"WHERE X.URETICI_KODU='004-08-18' ) ANATABLO " & _
"WHERE (ANATABLO.BAKIYE,0 IS NULL)<> (ANATABLO.MINBAKIYE,0 IS NULL) " & _
"AND (( " & _
"SELECT COUNT(* IS NULL) " & _
"FROM TBLSTSABIT " & _
"WHERE URETICI_KODU = ANATABLO.URETICI_KODU) ,0) > 1"
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Üst