- Katılım
- 20 Haziran 2008
- Mesajlar
- 697
- Excel Vers. ve Dili
- Microsoft Office ev ve iş 2019
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Secili_Alani_Text_Dosyasina_Yaz()
Dim DosyaYolu As String
Dim YolAyirici As String
Dim DosyaAdi As String
Dim DosyaSatiri As String
Dim i As Long
Dim j As Integer
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
MsgBox "Büyük Olasılıkla Hücreleri Seçmediniz..."
Exit Sub
End If
DosyaYolu = ThisWorkbook.Path
YolAyirici = Application.PathSeparator
DosyaAdi = "Dosya-" & Format(Date, "yyyy-mm-dd") & ".txt"
Open DosyaYolu & YolAyirici & DosyaAdi For Output As #1
For i = 1 To Selection.Rows.Count
DosyaSatiri = ""
For j = 1 To Selection.Columns.Count
If j <> Selection.Columns.Count Then
DosyaSatiri = DosyaSatiri & Selection(i, j) & vbTab
Else
DosyaSatiri = DosyaSatiri & Selection(i, j)
End If
Next j
Print #1, DosyaSatiri
Next i
Close #1
MsgBox "Dosya " & DosyaYolu & " Dizinine " & DosyaAdi & " Adında Oluşturuldu"
End Sub
buradaki dosya yerine excel hangi dosya adına kayıtlıysa o ismi verebilirmiyiz.DosyaAdi = "Dosya-" &
buradaki dosya yerine excel hangi dosya adına kayıtlıysa o ismi verebilirmiyiz.
Örneğin deneme.xls dosyası na text ye çevirirken deneme 01.08.2010
DosyaAdi = Split(ThisWorkbook.Name, ".")(0) & "-" & Format(Date, "yyyy-mm-dd") & ".txt"
DosyaAdi = Split(ThisWorkbook.Name, ".")(0) & ".txt"
DosyaAdi = Split(ThisWorkbook.Name, ".")(0) & "-" & Format(Date, "yyyy-mm-dd") & ".txt"
Bu şekilde tam istediğim gibi oldu hocam elinize sağlık.
Son bir şey daha rica edeceğim hocam
Excel dosyam hangi klasördeyse veya masa üstündeyse txt yi oraya kaydediyor
Dosyam nerede olursa olsun T.X.T kayıt yolu C:\ebyn\Ba Bs klasörü olsa olurmu
DosyaYolu = ThisWorkbook.Path
DosyaYolu = "C:\ebyn\Ba Bs"
:hihoho: hocam elinize sağlık tekrar çok teşekkür ederim.Gerçektekten Gönülden şükranlarımı sunarım zahmet verdim yardımlarınız için minnettarımBu soruların geleceğini bildiğim için kodları açık açık yazmayı yeğlemiştim.
:hihoho: hocam elinize sağlık tekrar çok teşekkür ederim.Gerçektekten Gönülden şükranlarımı sunarım zahmet verdim yardımlarınız için minnettarım
Merhaba,
Aşağıdaki kodları dener misiniz?
Önce hücreleri seçin sonra kodları çalıştırın.
Kod:Sub Secili_Alani_Text_Dosyasina_Yaz() Dim DosyaYolu As String Dim YolAyirici As String Dim DosyaAdi As String Dim DosyaSatiri As String Dim i As Long Dim j As Integer If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then MsgBox "Büyük Olasılıkla Hücreleri Seçmediniz..." Exit Sub End If DosyaYolu = ThisWorkbook.Path YolAyirici = Application.PathSeparator DosyaAdi = "Dosya-" & Format(Date, "yyyy-mm-dd") & ".txt" Open DosyaYolu & YolAyirici & DosyaAdi For Output As #1 For i = 1 To Selection.Rows.Count DosyaSatiri = "" For j = 1 To Selection.Columns.Count If j <> Selection.Columns.Count Then DosyaSatiri = DosyaSatiri & Selection(i, j) & vbTab Else DosyaSatiri = DosyaSatiri & Selection(i, j) End If Next j Print #1, DosyaSatiri Next i Close #1 MsgBox "Dosya " & DosyaYolu & " Dizinine " & DosyaAdi & " Adında Oluşturuldu" End Sub