Skip to main content

AccessTr.neT


Excele Gönderme Kodunda Yardım

Excele Gönderme Kodunda Yardım

Çözüldü #1
merhabalar, 


sitede bulduğum ve kullandığım aşağıdaki kod ile liste kutsundaki verileri excele gönderiyorum. Excel dosyasını direkt belglerim klasörüne kaydediyor.
acaba kaydedeceği yeri biz seçsek, kayıt yerinde ekran açılsa ve sorsa, yapılabilir mi?



Dim rsExcel As New ADODB.Recordset, dosya As String
dosya = "belge1"
Dim dbSurucu As String
Dim dbDosya As String
Dim dbExcel As Object
Dim fdExcel As Object
Dim vbExcel As Object
Dim vbBook As Object
Dim vbSheet As Object
Set vbExcel = CreateObject("Excel.Application")
Set vbBook = vbExcel.Workbooks.Add
rsExcel.Open Me.Liste60.RowSource, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Set vbSheet = vbBook.Worksheets(1)
Dim fdArray, fdCount, rdCount
fdCount = 0
For Each fdExcel In rsExcel.Fields
fdCount = fdCount + 1
If fdCount > 1 Then
fdArray = fdArray & "<,>" & fdExcel.Name
Else
fdArray = fdExcel.Name
End If
Next
With vbSheet.Range("A1")
.Resize(1, fdCount) = Split(fdArray, "<,>")
.Resize(1, fdCount).Font.Color = &HFF0000
End With
rdCount = 1
While Not rsExcel.EOF
rdCount = rdCount + 1
fdCount = 0
For Each fdExcel In rsExcel.Fields
fdCount = fdCount + 1
vbSheet.Cells(rdCount, fdCount) = fdExcel.Value
Next
rsExcel.MoveNext
Wend
vbSheet.Cells.Select
vbSheet.Cells.EntireColumn.AutoFit
vbSheet.Range("A1").Select
vbBook.SaveAs
vbExcel.Quit
Set dbExcel = Nothing
Set rsExcel = Nothing
Set vbExcel = Nothing
Set vbBook = Nothing
Set vbSheet = Nothing
Cevapla
#2
41. Satırı silin ve aşağıdaki kodu yazın.
Application.Dialogs(xlDialogSaveAs).Show
 İyi olan tek şey bilgi ve kötü olan tek şey de cehalettir. (Sokrates)
Cevapla
#3
(20/03/2024, 16:52)onur_can yazdı: 41. Satırı silin ve aşağıdaki kodu yazın.
Application.Dialogs(xlDialogSaveAs).Show

merhaba Onur_can,
kodu ekledim, fakat hata verdi.
.rar Örnek.rar (Dosya Boyutu: 29,31 KB | İndirme Sayısı: 2)
Cevapla
#4
Merhaba
Öncelikle Vba editöründen Tools-References Kısmından,
Microsoft Office XX Object Library (Buradaki XX Ofis versiyonudur 12.0, 14.0 veya 15.0 olabilir)
Daha sonra aşağıdaki kodu belirtilen yere ekleyiniz.

'vbBook.SaveAs

Dim DosyaKayit As FileDialog
Set DosyaKayit = Application.FileDialog(msoFileDialogSaveAs)
With DosyaKayit
.InitialFileName = "C:\Kitap1.xlsx"
.Show
End With

vbExcel.Quit
Set DosyaKayit = Nothing
 İyi olan tek şey bilgi ve kötü olan tek şey de cehalettir. (Sokrates)
Cevapla
#5
sn onur_can, teşekkür ederim,
iyi çalışmalar dilerim.
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task