Txt Dosyası Oluştur Butonu

[emnozdemir]

Hocam fazla oluyorum ama, bu konuyla ilgili bir şey daha istesem.
Dosya oluşturma işlemi tamamlanınca "aktarma işi tamamlandı" mesajı yerine verdiğimiz dosya adını yazsa.

Örneğin: ".............txt Dosyası Masa üstüne kaydedildi." yazsa.

yardımcı olurmusunuz?

 

[halit3]

Hocam fazla oluyorum ama, bu konuyla ilgili bir şey daha istesem.
Dosya oluşturma işlemi tamamlanınca "aktarma işi tamamlandı" mesajı yerine verdiğimiz dosya adını yazsa.

Örneğin: ".............txt Dosyası Masa üstüne kaydedildi." yazsa.

yardımcı olurmusunuz?

Kod

Option Explicit
Sub aktar()
Dim klasor, dosyaadi, i
klasor = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop")
dosyaadi = InputBox("Dosya adını yazın.", "UYARI!", Format(Now, "dd-mmm-yy h-mm-ss"))
If dosyaadi = "" Then
MsgBox "Dosya adı boş olamaz"
Exit Sub
End If
Open klasor & "\" & dosyaadi & ".txt" For Output As #1
For i = 1 To Worksheets("Txt Dosyası").Cells(Rows.Count, "a").End(3).Row
Print #1, Worksheets("Txt Dosyası").Cells(i, 1).Value
Next i
MsgBox dosyaadi & "  Dosyası masa üstüne kayıt edildi"
Close #1
End Sub

 

[emnozdemir]

Teşekkür ederim..

 

[emnozdemir]

Sadece A hücresinde değil de A,B,C,D,E hücrelerinde de veri olduğunu varsayarsak, ve o şekilde kaydetmek istersek vermiş olduğunuz kodların yazımında nasıl bir değişiklik yapmak lazım ?

 

[halit3]

Sadece A hücresinde değil de A,B,C,D,E hücrelerinde de veri olduğunu varsayarsak, ve o şekilde kaydetmek istersek vermiş olduğunuz kodların yazımında nasıl bir değişiklik yapmak lazım ?

Kod

Option Explicit
Sub aktar()
Dim klasor, dosyaadi, i, a, b, c, d, e
klasor = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop")
dosyaadi = InputBox("Dosya adını yazın.", "UYARI!", Format(Now, "dd-mmm-yy h-mm-ss"))
If dosyaadi = "" Then
MsgBox "Dosya adı boş olamaz"
Exit Sub
End If
Open klasor & "\" & dosyaadi & ".txt" For Output As #1
For i = 1 To Worksheets("Txt Dosyası").Cells(Rows.Count, "a").End(3).Row
a = Worksheets("Txt Dosyası").Cells(i, 1).Value & " "
b = Worksheets("Txt Dosyası").Cells(i, 2).Value & " "
c = Worksheets("Txt Dosyası").Cells(i, 3).Value & " "
d = Worksheets("Txt Dosyası").Cells(i, 4).Value & " "
e = Worksheets("Txt Dosyası").Cells(i, 5).Value
Print #1, a & b & c & d & e
Next i
MsgBox dosyaadi & "  Dosyası masa üstüne kayıt edildi"
Close #1
End Sub

 

[emnozdemir]

Çok Teşekkür ederim.

 

[halit3]

Çok Teşekkür ederim.

İyi çalışmalar