SqL den Excele aktarımda...

[resolve45]

Aşagıda belirtiğim sql sevrer üzerinden excele aktarılan kod'a plasiyer kodu da eklemek istiyorum yani plasiyer koduna göre de rapor almak istiyorum bunu nasıl yapabilirim.

Private Sub ComboBox1_Change()

End Sub

Private Sub CommandButton1_Click()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SqlText As String
With conn
.Provider = "sqloledb"
.CommandTimeout = 120
.ConnectionString = "Data Source=" & Sheet1.Cells(4, 5).Value & ";USER ID=" & Sheet1.Cells(8, 5).Value & ";PASSWORD=" & Sheet1.Cells(10, 5).Value & ";AUTO TRANSLATE=FALSE"
.Open
.DefaultDatabase = Sheet2.ComboBox1.Text
End With
SqlText = "SELECT A.CARI_KOD,B.CARI_ISIM,"
SqlText = SqlText + " BORC = SUM(CASE WHEN A.BORC>0 THEN A.BORC ELSE 0 END),"
SqlText = SqlText + " ALACAK = SUM(CASE WHEN A.ALACAK>0 THEN A.ALACAK ELSE 0 END),"
SqlText = SqlText + " BORCBAK = (CASE WHEN (SUM(CASE WHEN A.BORC>0 THEN A.BORC ELSE 0 END)-SUM(CASE WHEN A.ALACAK>0 THEN A.ALACAK ELSE 0 END))>0 THEN (SUM(CASE WHEN A.BORC>0 THEN A.BORC ELSE 0 END)-SUM(CASE WHEN A.ALACAK>0 THEN A.ALACAK ELSE 0 END)) ELSE 0 END),"
SqlText = SqlText + " ALACBAK = (CASE WHEN (SUM(CASE WHEN A.BORC>0 THEN A.BORC ELSE 0 END)-SUM(CASE WHEN A.ALACAK>0 THEN A.ALACAK ELSE 0 END))<0 THEN (SUM(CASE WHEN A.BORC>0 THEN A.BORC ELSE 0 END)-SUM(CASE WHEN A.ALACAK>0 THEN A.ALACAK ELSE 0 END))*-1 ELSE 0 END)"
SqlText = SqlText + " FROM TBLCAHAR A JOIN TBLCASABIT B ON (A.CARI_KOD=B.CARI_KOD)"
SqlText = SqlText + " WHERE TARIH BETWEEN '" + Format$(Sheet2.Cells(2, 2), "yyyy-mm-dd") + "' AND '" + Format$(Sheet2.Cells(3, 2), "yyyy-mm-dd") + "'"
SqlText = SqlText + " AND B.CARI_TIP IN ('" & Sheet2.Cells(4, 2).Value & "','" & Sheet2.Cells(4, 3).Value & "','" & Sheet2.Cells(4, 4).Value & "','" & Sheet2.Cells(4, 5).Value & "','" & Sheet2.Cells(4, 6).Value & "','" & Sheet2.Cells(4, 7).Value & "')"
SqlText = SqlText + " GROUP BY A.CARI_KOD,B.CARI_ISIM"
SqlText = SqlText + " ORDER BY A.CARI_KOD ASC "
rs.Open SqlText, conn, adOpenStatic, adLockReadOnly
Sheet2.Range("B7:G10000").ClearContents
Sheet2.Activate
i = 7
Do While Not rs.EOF
Sheet2.Cells(1, 1).Value = i + 1
Sheet2.Cells(i, 2).Value = rs(0)
Sheet2.Cells(i, 3).Value = rs(1)
Sheet2.Cells(i, 4).Value = rs(2)
Sheet2.Cells(i, 5).Value = rs(3)
Sheet2.Cells(i, 6).Value = rs(4)
Sheet2.Cells(i, 7).Value = rs(5)
rs.MoveNext
i = i + 1
Loop
MusToplam
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing

End Sub

Public Sub MusToplam()
Range("B7:G10000").Select
Selection.Font.Bold = False
Range("B" & Sheet2.Cells(1, 1) & ":G" & Sheet2.Cells(1, 1) & "").Select
Selection.Font.Bold = True
Sheet2.Activate
Sheet2.Cells(Sheet2.Cells(1, 1), 3).Value = "Genel Toplam"
Range("D" & Sheet2.Cells(1, 1) & "" & Sheet2.Cells(1, 1) & "").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-" & Sheet2.Cells(1, 1) - 7 & "]C:R[-1]C)"
Range("E" & Sheet2.Cells(1, 1) & ":E" & Sheet2.Cells(1, 1) & "").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-" & Sheet2.Cells(1, 1) - 7 & "]C:R[-1]C)"
Range("F" & Sheet2.Cells(1, 1) & ":F" & Sheet2.Cells(1, 1) & "").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-" & Sheet2.Cells(1, 1) - 7 & "]C:R[-1]C)"
Range("G" & Sheet2.Cells(1, 1) & ":G" & Sheet2.Cells(1, 1) & "").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-" & Sheet2.Cells(1, 1) - 7 & "]C:R[-1]C)"


End Sub

Private Sub OptionButton1_Click()

End Sub

Private Sub OptBtnAlici_Click()

End Sub

Private Sub OptionButton3_Click()

End Sub

 

[Taruz]

SqlText = "SELECT A.CARI_KOD,B.CARI_ISIM, PlasiyerKodAlanıİsmi,"

İlgili satırı bu şekilde değiştiriniz..


Yerleşim içinse bu değişiklikleri yapmanız gerek..:

i = 8
....
.......
............
Sheet2.Cells(i, 7).Value = rs(5)
Sheet2.Cells(i, 8).Value = rs(6)

 

[resolve45]

tşk ederim