+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html)
+--- Forum: Access Cevaplanmış Soruları (https://accesstr.net/forum-access-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Excele Gönderme Kodunda Yardım (/konu-excele-gonderme-kodunda-yardim.html)
Excele Gönderme Kodunda Yardım - adalet20 - 20/03/2024
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 = NothingRE: Excele Gönderme Kodunda Yardım - onur_can - 20/03/2024
41. Satırı silin ve aşağıdaki kodu yazın.
Application.Dialogs(xlDialogSaveAs).ShowRE: Excele Gönderme Kodunda Yardım - adalet20 - 21/03/2024
(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.
RE: Excele Gönderme Kodunda Yardım - onur_can - 21/03/2024
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 = NothingRE: Excele Gönderme Kodunda Yardım - adalet20 - 21/03/2024
sn onur_can, teşekkür ederim,
iyi çalışmalar dilerim.