Excele Aktarma Ve Biçimlendirme - zaferlacin - 29/12/2019
excele aktar butonuna basınca kod bir çalışıyor ikinci yada üçüncü çalışmasında global failed hatası veriyor
bir de Excel son satırı seçiyorum ama oraya tutarların toplamını yazdırmak istiyorum
teşekkür ederim
Cvp: Excele Aktarma Ve Biçimlendirme - zaferlacin - 29/12/2019
Global failed hatasını çözemedim bakabilirseniz sevinirim
Cvp: Excele Aktarma Ve Biçimlendirme - ozanakkaya - 30/12/2019
Merhaba, hata oluştuğundaki ekran görüntüsünü yollayın.
Cvp: Excele Aktarma Ve Biçimlendirme - zaferlacin - 30/12/2019
(30/12/2019, 10:07)ozanakkaya yazdı: Merhaba, hata oluştuğundaki ekran görüntüsünü yollayın. hocam ilk gönderdiğimi değiştirdim
yine de aynı hatayı veriyor ilk çalışmada çalışıyor
ikincide hata debug oluyor
debug tan sonra birdaha çalışıyor
sonra yine hata veriyor
Cvp: Excele Aktarma Ve Biçimlendirme - ozanakkaya - 30/12/2019
Butonun tıklandığında olayındaki kodları aşağıdaki ile değiştirerek deneyiniz.
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
Cvp: Excele Aktarma Ve Biçimlendirme - zaferlacin - 30/12/2019
(30/12/2019, 11:13)ozanakkaya yazdı: Butonun tıklandığında olayındaki kodları aşağıdaki ile değiştirerek deneyiniz.
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
Tamamdır hocam emeğinize sağlık
ilginize de ayrı teşekkür
|