Soru Vba satır biçimlendirme

Katılım
1 Ağustos 2006
Mesajlar
179
Altın Üyelik Bitiş Tarihi
22-08-2024
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


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
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Konu başlığını, sorununuzu özetleyen anlamlı bir metinle değiştirmenizde fayda var....

.
 
Üst