merhaba
A-E kadar sütünlarım var
A8 den başlıyor gelen çektiğim veri kadar satıların biçimli olması yapmadım yardımcı olmanızı rica ederim
A-E kadar sütünlarım var
A8 den başlıyor gelen çektiğim veri kadar satıların biçimli olması yapmadım yardımcı olmanızı rica ederim
PHP:
'Bismillahirrahmanirrahîm.'
Sub Kasa_Detay()
Dim Server As String, Database As String, Kullanıcı As String, Parola As String
Dim sss As Long, Topla As Long, Son As Long, Say As Long, liste(), Veri(), Zaman As Double
Dim S1 As Worksheet, S2 As Worksheet, X As Long
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set S2 = Sheets("Ayar")
Zaman = Timer
'***********************************************************************************************************************************************
With Application
.ScreenUpdating = False
End With
'Bağlantı Tanımlama************************************************************************************************************************************************
'Range("A9:AZ" & Rows.Count).Borders.LineStyle = 0
'Range("A9:AZ" & Rows.Count).ClearContents
Server = S2.Range("b2").Value:
Database = S2.Range("b3").Value:
Kullanıcı = S2.Range("b4").Value:
Parola = S2.Range("b5").Value
Firma = Format(Mid(S2.Range("B1"), 4, 3), "000")
Firmaa = Format(Mid(S2.Range("B1"), 4, 3), "000") * 1
Dönem = Format(Mid(S2.Range("B1"), 1, 2), "00")
KASA = Range("B1")
Set con = CreateObject("ADODB.Connection")
con.Open "Provider=SQLOLEDB; Data Source=" & Server & "; Initial Catalog=" & Database & "; User ID=" & Kullanıcı & "; Password=" & Parola & ";"
Set rs = CreateObject("adodb.recordset")
'Sql Kod************************************************************************************************************************************************
s = s & " SELECT CLCARD.CODE as [KODU], CLCARD.DEFINITION_ as [UNVAN] , CLCARD.TELNRS1 as [TEL],CLCARD.TELNRS1 as [TEL2],CLFLINE.AMOUNT AS [BORÇ],CLFLINE.AMOUNT AS [ALACAK]"
s = s & " FROM LG_211_CLCARD AS CLCARD INNER JOIN LG_211_01_CLFLINE AS CLFLINE ON CLCARD.LOGICALREF=CLFLINE.CLIENTREF "
s = s & " WHERE CLCARD.ACTIVE=0 AND CLCARD.CODE='T-İTH130-110' AND YEAR(CLFLINE.DATE_)='2018'"
con.CommandTimeout = 10000
rs.Open s, con, 1, 1
'Alttoplam Alma*********************************************************************************************************************************************
Sayfa1.Range("A9:E" & Rows.Count).Clear
With Sayfa1
With .Range("A8:B8")
.Interior.ThemeColor = xlThemeColorLight1
.Interior.TintAndShade = -0.749992370372631
.Font.ThemeColor = xlThemeColorDark2
.Font.Bold = True
.VerticalAlignment = xlCenter
.WrapText = False
Orientation = 0
AddIndent = False
IndentLevel = 0
.ShrinkToFit = False
ReadingOrder = xlContext
.MergeCells = False
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ThemeColor = 2
.Borders(xlEdgeLeft).TintAndShade = 0.499984740745262
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ThemeColor = 2
.Borders(xlEdgeTop).TintAndShade = 0.499984740745262
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ThemeColor = 2
.Borders(xlEdgeBottom).TintAndShade = 0.499984740745262
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ThemeColor = 2
.Borders(xlEdgeRight).TintAndShade = 0.499984740745262
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).ThemeColor = 2
.Borders(xlInsideVertical).TintAndShade = 0.499984740745262
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Rows("8:8").Select
.RowHeight = 30
End With
'----ALTSUTNRENKLENDIRMA
Son = .Range("a65536").End(3).Row
With Sayfa1.Range("A19" & Son)
.VerticalAlignment = xlCenter
.WrapText = False
Orientation = 0
AddIndent = False
IndentLevel = 0
.ShrinkToFit = False
ReadingOrder = xlContext
.MergeCells = False
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ColorIndex = 0
.Borders(xlEdgeLeft).TintAndShade = 0
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 0
.Borders(xlEdgeTop).TintAndShade = 0
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 0
.Borders(xlEdgeBottom).TintAndShade = 0
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ColorIndex = 0
.Borders(xlEdgeRight).TintAndShade = 0
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).ColorIndex = 0
.Borders(xlInsideVertical).TintAndShade = 0
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).ColorIndex = 0
.Borders(xlInsideHorizontal).TintAndShade = 0
.Borders(xlInsideHorizontal).Weight = xlThin
End With
'----ALTSUTNRENKLENDIRMA
Sayfa1.Cells(8, "A") = "BORÇ": Sayfa1.Cells(8, "B") = "ALACAK"
Sayfa1.Range("B4") = rs.Fields("KODU").Value
Sayfa1.Range("B5") = rs.Fields("UNVAN").Value
Sayfa1.Range("B6") = rs.Fields("TEL").Value
i = 9
rs.MoveFirst
Do While Not rs.EOF
Sayfa1.Cells(i, "A") = rs.Fields("BORÇ").Value
Sayfa1.Cells(i, "B") = rs.Fields("ALACAK").Value
i = i + 1
rs.MoveNext
Sayfa1.Range("A9:E" & Son).NumberFormat = "#,##0.00"
Loop
.Range("a9").CopyFromRecordset rs
Son = .Range("a65536").End(3).Row
.Columns.AutoFit
End With
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
'**********************************************************************************************************************************************
With Application
.ScreenUpdating = True
End With
Sayfa1.Columns("A:B").ColumnWidth = 30
Application.ScreenUpdating = True
MsgBox "İşleminiz Tamamlanmıştır. " & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format((Timer - Zaman) / 60, "0.00") & " Saniye", vbInformation, "Tebrik"
End Sub