Skip to main content

AccessTr.neT

Kayıt Ol

 | Facebook ile Bağlan  | Twitter İle Bağlan | Google+ İle Bağlan

Excele Aktarma Ve Biçimlendirme

zaferlacin
zaferlacin
Access Cevaplanmış Soruları
5
1142

Excele Aktarma Ve Biçimlendirme

Çözüldü #1
zaferlacin
Aktif Üye
zaferlacin
Bul
Aktif Üye
Adı Soyadı: Za.... La....
Yaşı: 55
Konum: Balıkesir
Ofis Versiyonu: Ofis 2016 64 Bit
Son Oturumu: 28/11/2022,23:34
Yorumları: 182
Konuları: 46
Kayıt Tarihi: 11/08/2013
Teşekkür Puanı: 0
Mesleğiniz: Emekli
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
zaferlacin
Aktif Üye
zaferlacin
Bul
Aktif Üye
Adı Soyadı: Za.... La....
Yaşı: 55
Konum: Balıkesir
Ofis Versiyonu: Ofis 2016 64 Bit
Son Oturumu: 28/11/2022,23:34
Yorumları: 182
Konuları: 46
Kayıt Tarihi: 11/08/2013
Teşekkür Puanı: 0
Mesleğiniz: Emekli
Global failed hatasını çözemedim bakabilirseniz sevinirim
Cevapla
#3
ozanakkaya
sledgeab
ozanakkaya
Bul
Kurucu
Adı Soyadı: Oz.... Ak....
Konum: Denizli
Ofis Versiyonu: Ofis 2016 64 Bit
Son Oturumu: Bugün,22:12
Yorumları: 13.536
Konuları: 499
Kayıt Tarihi: 29/01/2008
Teşekkür Puanı: 3.139
Mesleğiniz: Memur
Merhaba, hata oluştuğundaki ekran görüntüsünü yollayın.
Cevapla
#4
zaferlacin
Aktif Üye
zaferlacin
Bul
Aktif Üye
Adı Soyadı: Za.... La....
Yaşı: 55
Konum: Balıkesir
Ofis Versiyonu: Ofis 2016 64 Bit
Son Oturumu: 28/11/2022,23:34
Yorumları: 182
Konuları: 46
Kayıt Tarihi: 11/08/2013
Teşekkür Puanı: 0
Mesleğiniz: Emekli
(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
.rar Desktop.rar (Dosya Boyutu: 293,45 KB | İndirme Sayısı: 6)
Cevapla
#5
ozanakkaya
sledgeab
ozanakkaya
Bul
Kurucu
Adı Soyadı: Oz.... Ak....
Konum: Denizli
Ofis Versiyonu: Ofis 2016 64 Bit
Son Oturumu: Bugün,22:12
Yorumları: 13.536
Konuları: 499
Kayıt Tarihi: 29/01/2008
Teşekkür Puanı: 3.139
Mesleğiniz: Memur
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
Cevapla
#6
zaferlacin
Aktif Üye
zaferlacin
Bul
Aktif Üye
Adı Soyadı: Za.... La....
Yaşı: 55
Konum: Balıkesir
Ofis Versiyonu: Ofis 2016 64 Bit
Son Oturumu: 28/11/2022,23:34
Yorumları: 182
Konuları: 46
Kayıt Tarihi: 11/08/2013
Teşekkür Puanı: 0
Mesleğiniz: Emekli
(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
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da