Skip to main content

AccessTr.neT


Excele Aktarma Ve Biçimlendirme

Excele Aktarma Ve Biçimlendirme

Çözüldü #1
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
.rar Deneme.rar (Dosya Boyutu: 146,55 KB | İndirme Sayısı: 2)
Cevapla
#2
Global failed hatasını çözemedim bakabilirseniz sevinirim
Cevapla
#3
Merhaba, hata oluştuğundaki ekran görüntüsünü yollayın.
"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 
Cevapla
#4
(30/12/2019 10:07)ozanakkaya Adlı Kullanıcıdan Alıntı: 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
.rar Desktop.rar (Dosya Boyutu: 293,45 KB | İndirme Sayısı: 5)
Cevapla
#5
Butonun tıklandığında olayındaki kodları aşağıdaki ile değiştirerek deneyiniz.

Visual Basic Code
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
"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 
Cevapla
#6
(30/12/2019 11:13)ozanakkaya Adlı Kullanıcıdan Alıntı: Butonun tıklandığında olayındaki kodları aşağıdaki ile değiştirerek deneyiniz.

Visual Basic Code
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
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da