AccessTr.neT

Tam Versiyon: Access İle Excel Hücresi Biçimlendirme
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3
(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
Butonun tıklandığında olayına aşağıdaki kodu ekleyerek deneyiniz.
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.
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.
hocam işte bu 
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ı: [ -> ]
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"
Hocam Bu Kod Oldu Olmasına da
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
Sayfalar: 1 2 3