(30/12/2019, 11:13)ozanakkaya yazdı: Butonun tıklandığında olayındaki kodları aşağıdaki ile değiştirerek deneyiniz.Tamamdır hocam emeğinize sağlık
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim objWkb As Excel.Workbook
GToplam = 0
Set objWkb = Nothing
Set xlApp = Nothing
Set xlApp = New Excel.Application
xlApp.Visible = True
Set objWkb = xlApp.Workbooks.Add
xlApp.ActiveWindow.WindowState = xlMaximized
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'Excel.Workbooks(1).Worksheets(1).Name = "sheetname" 'sayfa adını değiştirmek
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xlApp.Sheets(1).Range("A3", "A3").Select 'Hücreleri dondur
xlApp.ActiveWindow.FreezePanes = True
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
With xlApp.Sheets(1)
.Range("B1") = "ALINMASI GEREKEN KİRALAR"
.Range("F1") = "ALINAN KİRALAR"
.Range("A2") = "TARİH"
.Range("B2") = "AÇIKLAMA"
.Range("C2") = "TUTAR"
.Range("E2") = "TARİH"
.Range("F2") = "AÇIKLAMA"
.Range("G2") = "TUTAR"
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
With xlApp.Sheets(1)
xlApp.Sheets(1).Range("A1").Select
xlApp.Sheets(1).Range("A1").ColumnWidth = "14"
xlApp.Sheets(1).Range("B1").ColumnWidth = "40"
xlApp.Sheets(1).Range("C1").ColumnWidth = "9"
xlApp.Sheets(1).Range("D1").ColumnWidth = "1"
xlApp.Sheets(1).Range("E1").ColumnWidth = "14"
xlApp.Sheets(1).Range("F1").ColumnWidth = "40"
xlApp.Sheets(1).Range("G1").ColumnWidth = "9"
End With
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
With xlApp.Sheets(1)
.Range("A1:G1").Interior.Color = RGB(0, 245, 255)
.Range("A2:G2").Interior.Color = RGB(255, 255, 0)
.Range("A1:G2").HorizontalAlignment = xlCenter
.Range("A1:A155").HorizontalAlignment = xlCenter
.Range("b1").Font.Color = RGB(255, 0, 0)
.Range("f1").Font.Color = RGB(255, 0, 0)
.Range("b1:f1").Font.Size = 13
'.Range("f1").Font.Size = 13
'.Range("b1:F1").Borders.Weight = xlThick
.Range("a1:g2").Font.FontStyle = "Bold"
End With
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Set Rng = .Range("A2:C" & Me.Liste5.ListCount + 6)
End With
Rng.Borders.Weight = 2 'ara çizgilerin kalınlığı
Rng.BorderAround Weight:=3 'Çerçeve kalınlığı
With xlApp.Sheets(1)
Set Rng = .Range("E2:G" & Me.Liste5.ListCount + 6)
End With
Rng.Borders.Weight = 2 'ara çizgilerin kalınlığı
Rng.BorderAround Weight:=3 'Çerçeve kalınlığı
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
For I = 0 To Me.Liste5.ListCount - 1
xlApp.Sheets(1).Cells(I + 3, 1).Value = Me.Liste5.Column(1, I)
xlApp.Sheets(1).Cells(I + 3, 3).Value = Me.Liste5.Column(2, I)
xlApp.Sheets(1).Cells(I + 3, 2).Value = Me.Liste5.Column(3, I)
GToplam = GToplam + Nz(Me.Liste5.Column(2, I), 0)
Next I
For K = 0 To Me.Liste6.ListCount - 1
xlApp.Sheets(1).Cells(K + 3, 5).Value = Me.Liste6.Column(1, K)
xlApp.Sheets(1).Cells(K + 3, 7).Value = Me.Liste6.Column(2, K)
xlApp.Sheets(1).Cells(K + 3, 6).Value = Me.Liste6.Column(3, K)
Next K
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
With xlApp.Sheets(1)
'[H1] = Selection
'Selection.Value = "=SUM(C2:SELECTION)"
Dim H As Integer
H = 0
H = .Range("C65536").End(xlUp).Row
.Range("C65536").End(xlUp).Offset(6, 0).Select
xlApp.Sheets(1).Range("a1").Value = H
'.Selection = H
xlApp.Sheets(1).Range("C" & H + 6).Value = GToplam
End With
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' myWorkbook.Sheets(sheetIn).Name = "New Sheet Name"
Set selction = Nothing
Set objWkb = Nothing
Set xlApp = Nothing
Set xlSh = Nothing
ilginize de ayrı teşekkür
