(19/12/2019, 14:31)berduş yazdı: ben mi gözden kaçırdım bilemiyorum ama çalışmanızda excele aktarılmasını istemeniz dışında ne istediğinize dair bir ipucu bulamadım. excelde bir çerçeve var ama o kadar.var olan bir excel'e değil yeni bir Excel açarak atmasını ve o çerçeveleri direk komut ile çizmesini istiyorum
Access İle Excel Hücresi Biçimlendirme
Butonun tıklandığında olayına aşağıdaki kodu ekleyerek deneyiniz.
Referanslara Excel referansını eklemeyi unutmayın.
Ayrıca, lütfen konularınızı Site Kurallarına uygun olarak açınız.
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim objWkb As Excel.Workbook
Set xlApp = New Excel.Application
xlApp.Visible = True
Set objWkb = xlApp.Workbooks.Add
With xlApp.Sheets(1)
Set Rng = .Range("B2:H15")
End With
Rng.Borders.Weight = 2
With Rng.Borders(7)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(8)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(9)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(10)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
Referanslara Excel referansını eklemeyi unutmayın.
Ayrıca, lütfen konularınızı Site Kurallarına uygun olarak açınız.
(19/12/2019, 15:29)ozanakkaya yazdı: Butonun tıklandığında olayına aşağıdaki kodu ekleyerek deneyiniz.hocam işte bu
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim objWkb As Excel.Workbook
Set xlApp = New Excel.Application
xlApp.Visible = True
Set objWkb = xlApp.Workbooks.Add
With xlApp.Sheets(1)
Set Rng = .Range("B2:H15")
End With
Rng.Borders.Weight = 2
With Rng.Borders(7)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(8)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(9)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(10)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
Referanslara Excel referansını eklemeyi unutmayın.
Ayrıca, lütfen konularınızı Site Kurallarına uygun olarak açınız.
ama liste kutusundaki verileri nasıl aktarıcam
sitede sadece sorgu olarak vermiş ben sorgu olsun istemiyorum sadece liste kutusunun rowsource sini aktarsın istiyorum
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim objWkb As Excel.Workbook
Set xlApp = New Excel.Application
xlApp.Visible = True
Set objWkb = xlApp.Workbooks.Add
With xlApp.Sheets(1)
Set Rng = .Range("B2:H" & Me.Liste5.ListCount + 1)
End With
Rng.Borders.Weight = 2
With Rng.Borders(7)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(8)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(9)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(10)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
For i = 0 To Me.Liste5.ListCount - 1
xlApp.Sheets(1).Cells(i + 2, 2).Value = Me.Liste5.Column(0, i)
xlApp.Sheets(1).Cells(i + 2, 3).Value = Me.Liste5.Column(1, i)
xlApp.Sheets(1).Cells(i + 2, 4).Value = Me.Liste5.Column(2, i)
xlApp.Sheets(1).Cells(i + 2, 5).Value = Me.Liste5.Column(3, i)
xlApp.Sheets(1).Cells(i + 2, 6).Value = Me.Liste5.Column(4, i)
xlApp.Sheets(1).Cells(i + 2, 7).Value = Me.Liste5.Column(5, i)
xlApp.Sheets(1).Cells(i + 2, 8).Value = Me.Liste5.Column(6, i)
Next i
xlApp.Sheets(1).Range("B1").Select
xlApp.Sheets(1).Range("B1").ColumnWidth = "40"
eğer liste kutusundaki kriter alanlarındaki onayı kaldırırsanız
For i = 0 To Me.Liste5.ListCount - 1
xlApp.Sheets(1).Cells(i + 2, 2).Value = Me.Liste5.Column(0, i)
xlApp.Sheets(1).Cells(i + 2, 3).Value = Me.Liste5.Column(1, i)
xlApp.Sheets(1).Cells(i + 2, 4).Value = Me.Liste5.Column(2, i)
xlApp.Sheets(1).Cells(i + 2, 5).Value = Me.Liste5.Column(3, i)
xlApp.Sheets(1).Cells(i + 2, 6).Value = Me.Liste5.Column(4, i)
xlApp.Sheets(1).Cells(i + 2, 7).Value = Me.Liste5.Column(5, i)
xlApp.Sheets(1).Cells(i + 2, 8).Value = Me.Liste5.Column(6, i)
Next i
yukardaki yazdırma kodunu aşağıdaki ile değiştirebilirsiniz Dim rs As Recordset
Set rs = Me.Liste5.Recordset
rs.MoveFirst
xlApp.Sheets(1).Range("B2").CopyFromRecordset rs 'Me.Liste5.Recordset
Rng.Columns.AutoFit
(19/12/2019, 16:00)ozanakkaya yazdı:Hocam Bu Kod Oldu Olmasına daDim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim objWkb As Excel.Workbook
Set xlApp = New Excel.Application
xlApp.Visible = True
Set objWkb = xlApp.Workbooks.Add
With xlApp.Sheets(1)
Set Rng = .Range("B2:H" & Me.Liste5.ListCount + 1)
End With
Rng.Borders.Weight = 2
With Rng.Borders(7)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(8)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(9)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
With Rng.Borders(10)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = 3
End With
For i = 0 To Me.Liste5.ListCount - 1
xlApp.Sheets(1).Cells(i + 2, 2).Value = Me.Liste5.Column(0, i)
xlApp.Sheets(1).Cells(i + 2, 3).Value = Me.Liste5.Column(1, i)
xlApp.Sheets(1).Cells(i + 2, 4).Value = Me.Liste5.Column(2, i)
xlApp.Sheets(1).Cells(i + 2, 5).Value = Me.Liste5.Column(3, i)
xlApp.Sheets(1).Cells(i + 2, 6).Value = Me.Liste5.Column(4, i)
xlApp.Sheets(1).Cells(i + 2, 7).Value = Me.Liste5.Column(5, i)
xlApp.Sheets(1).Cells(i + 2, 8).Value = Me.Liste5.Column(6, i)
Next i
xlApp.Sheets(1).Range("B1").Select
xlApp.Sheets(1).Range("B1").ColumnWidth = "40"
biçimlendirmenin C5 ten başlaması için
Set Rng = .Range("B2:H" & Me.Liste5.ListCount + 1)
bu kodda B2 yi C5 yapıyorum C3 Ten başlıyor
C5 Ten başlatmak için hangi kodda değişiklik yapmak gerekir
Teşekkür ederim
Son Düzenleme: 19/12/2019, 20:18, Düzenleyen: zaferlacin.
(Sebep: Biçimlendirme hatalı oldu)
Konuyu Okuyanlar: 3 Ziyaretçi