Muhasebe.xls çalışma kitabındaki db sayfasını

[suatsuphi]

Merhaba arkadaşlar

Muhasebe.xls çalışma kitabındaki db sayfasını bir buton ile fatura.cvs olarak çalışma kitabının bulunduğu yere (örnek masaüstü veya belgelerim) kaydetmek istiyorum. CSV FORMATINI BİLİYORSUNUZ. virgülle ayrılmış olarak txt gibi kaydediyor.

Bu konuda yardımcı olabilicek arkadaşlara şimdiden çoooooooook teşekkürler

Saygılar

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub cevir()
Sheets("db").Copy
ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & "fatura.csv", FileFormat:=xlCSV
ActiveWorkbook.Close True
End Sub

 

[suatsuphi]

Levent Bey Teşekkürler...
Bu kodları denedim çalışıyor fakat şimdi şöyle bir prbolem ortaya çıktı

Dosya menüsünden farklı kaydetle csv formatında kaydettiğimde sutunlar arasında noktalı virgül ( kullanıyor... fakat bu makroyu kullandığımda , kullanıyor. Sutunlar arasında noktalı virgül yaptığımda problem çözülecek sanırım... Ama nasıl yapacağım konusunda yine yardıma ihtiyacım var...

cevabınız için teşekkürler

 

[Levent Menteşoğlu]

Bunu kodla kaydederken yapmak nasıl olur bilmiyorum ama dosyda ctrl+f ile değiştir penceresinde virgülü noktalı virgülle kolayca değiştirebilirsiniz.

Not:bu ayrım neden önemli onuda merak ettik açıkçası.

 

[suatsuphi]

ya ben bir şeye taktım mı takıyom nedenini neden yapamadığım üzerine çok dururum pratik şeyler yapmayı severim.
o yüzden taktım buna
ilk seferinde noktalı virgülle yaptı sonra bilgisayarı açıp kapatınca ilk seferde düzgün sonra bozuyor aslında fso ile dosayayı açıp virgülleri noktalı virgüle replace ile değiştiririm ama sayılarda ondalık kısmında da virgül var bu sefer karışıyor....

çok teşekkürler ilgilendiğiniz için
açıkçası neden dosya farklı kaydetle yapıp kodla yapamadığımı merak ediyorum...

 

[suatsuphi]

Sorumun Yanitini Buldum

sorumun yanıtını bir alman forumda buldum umarım işinize yarar

sorduğum noktalı virgül olayını buradan
strTrennzeichen = ";"
ayarlayabiliyorsunuz

Sub SaveCSV()



Sheets("DB").Select



Dim Bereich As Object, Zeile As Object, Zelle As Object

Dim strTemp As String

Dim strDateiname As String

Dim strTrennzeichen As String

Dim strMappenpfad As String



strMappenpfad = ActiveWorkbook.FullName

strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")



strDateiname = strMappenpfad

If strDateiname = "" Then Exit Sub



strTrennzeichen = ";"

If strTrennzeichen = "" Then Exit Sub



Set Bereich = ActiveSheet.UsedRange



Open strDateiname For Output As #1



For Each Zeile In Bereich.Rows

For Each Zelle In Zeile.Cells

If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then

'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen

strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen

Else

strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen

End If

Next

If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)

Print #1, strTemp

strTemp = ""

Next



Close #1

Set Bereich = Nothing

MsgBox "CSV DOSYASI AŞAĞIDAKİ YOLA KAYDEDİLDİ... MUHASEBE FİŞİNDE CTRL + F YAPTIKTAN SONRA, F10 İLE AŞAĞIDA YOLDA BELİRTİLEN DOSYAYI ÇAĞIRIN YEVMİYE KAYDINI OLUŞTURUN..." & vbCrLf & vbCrLf & strDateiname, , " DOSYA KAYDEDİLDİ"



End Sub