Txt Dosyası Oluştur Butonu

[emnozdemir]

Ekli Dosyada "Giriş" Sayfasında girilen bilgiler "Txt Dosyası" Sayfasına formül yardımıyla aktarılmaktadır. "Txt Dosyası" Sayfasını ise her seferinde (masa üstüne)Txt Dosyası olarak Kaydetmem gerekiyor. Bu işlemi yukarıya yerleştirdiğim buton vasıtasıyla yapmak istiyorum. Ama bir türlü beceremedim.
Yardımcı olur musunuz acaba ?

 

[halit3]

Ekli Dosyada "Giriş" Sayfasında girilen bilgiler "Txt Dosyası" Sayfasına formül yardımıyla aktarılmaktadır. "Txt Dosyası" Sayfasını ise her seferinde (masa üstüne)Txt Dosyası olarak Kaydetmem gerekiyor. Bu işlemi yukarıya yerleştirdiğim buton vasıtasıyla yapmak istiyorum. Ama bir türlü beceremedim.
Yardımcı olur musunuz acaba ?

Bu kodu denermisiniz.

[COLOR=red]Option Explicit[/COLOR]
Sub aktar()
[COLOR=red]Dim klasor, dosyaadi, i, deger1, deger2, deger3, deger4, deger5, deger6[/COLOR]
klasor = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop")
dosyaadi = Format(Now, "dd-mmm-yy h-mm-ss") & ".txt"
Open klasor & "\" & dosyaadi For Output As #1
For i = 2 To Worksheets(ActiveSheet.Name).Cells(Rows.Count, "a").End(3).Row
deger1 = Cells(i, 1).Value
deger2 = Cells(i, 2).Value
deger3 = Cells(i, 3).Value
deger4 = Cells(i, 4).Value
deger5 = Cells(i, 5).Value
deger6 = Cells(i, 6).Value
Print #1, deger1 & deger2 & deger3 & deger4 & deger5 & deger6
Next i
MsgBox "aktarma işi tamamlandı"
Close #1
End Sub

 

[emnozdemir]

Ekteki hata mesajı geldi ama anlayamadım.

 

[emnozdemir]

Gelen Hatada "klasor=" işaretliydi.

 

[halit3]

Gelen Hatada "klasor=" işaretliydi.

Değişkenleri tanımlamadığımdan hata alıyorsunuz.

Option Explicit olayını kaldırıp deneyin veya 2 nolu mesaja kırmızı eklediğim bölümü ile kodu yeniden çalıştırın.

 

[emnozdemir]

Teşekkür ederim Hocam, beyninize ve ellerinize sağlık

 

[halit3]

Teşekkür ederim Hocam, beyninize ve ellerinize sağlık

İyi çalışmalar

 

[emnozdemir]

Hocam çok pardon...
Ben "Txt Dosyası" Sayfasını Txt dosyası olarak kaydetmek istiyordum. Ama vermiş olduğunuz kodları butona atadığımda Giriş Sayfasını Txt Dosyası olarak kaydediyor, "Txt Dosyası" sayfasını değil. Şimdi uygulamadan sonra farkettim.

Kodları "Txt Dosyası" Sayfasını Txt dosyası olarak kaydedecek şekilde düzenleyebilirmiyiz ? Veya başka bir yol var mı?

 

[halit3]

Hocam çok pardon...
Ben "Txt Dosyası" Sayfasını Txt dosyası olarak kaydetmek istiyordum. Ama vermiş olduğunuz kodları butona atadığımda Giriş Sayfasını Txt Dosyası olarak kaydediyor, "Txt Dosyası" sayfasını değil. Şimdi uygulamadan sonra farkettim.

Kodları "Txt Dosyası" Sayfasını Txt dosyası olarak kaydedecek şekilde düzenleyebilirmiyiz ? Veya başka bir yol var mı?

kod

Option Explicit
Sub aktar()
Dim klasor, dosyaadi, i
klasor = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop")
dosyaadi = Format(Now, "dd-mmm-yy h-mm-ss") & ".txt"
Open klasor & "\" & dosyaadi For Output As #1
For i = 1 To Worksheets(ActiveSheet.Name).Cells(Rows.Count, "a").End(3).Row
Print #1, Cells(i, 1).Value
Next i
MsgBox "aktarma işi tamamlandı"
Close #1
End Sub

 

[emnozdemir]

Hocam son verdiğiniz kodlar da "Txt Dosyası" Sayfası verilerini txt dosyasına dönüştürmüyor.

 

[halit3]

Hocam son verdiğiniz kodlar da "Txt Dosyası" Sayfası verilerini txt dosyasına dönüştürmüyor.

siz kodu giriş sayfasındayken aktarıyorsunuz Txt Dosyası sayfasındayken kodu çalıştırsaydınız kod düzgün çalışacaktı neyse aşağıdaki kod her sayfada çalışıyor.

Option Explicit
Sub aktar()
Dim klasor, dosyaadi, i
klasor = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop")
dosyaadi = Format(Now, "dd-mmm-yy h-mm-ss") & ".txt"
Open klasor & "\" & dosyaadi 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 "aktarma işi tamamlandı"
Close #1
End Sub

 

[emnozdemir]

Teşekkür ederim hocam.
Size zahmet verdim.

 

[emnozdemir]

Kodlar harika çalışıyor. Ama bu konuyla ilgili olarak bir şey daha sormak istiyorum.
Kodları çalıştırınca Masaüstüne kaydediyor, otomatik olarak isim veriyor ya;
Bu dosyanın ismini bizim belirleme şansımız var mı acaba? Yani kaydederken dosyaya verilecek ismi sorsa ...

 

[halit3]

Kodlar harika çalışıyor. Ama bu konuyla ilgili olarak bir şey daha sormak istiyorum.
Kodları çalıştırınca Masaüstüne kaydediyor, otomatik olarak isim veriyor ya;
Bu dosyanın ismini bizim belirleme şansımız var mı acaba? Yani kaydederken dosyaya verilecek ismi sorsa ...

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 "aktarma işi tamamlandı"
Close #1
End Sub

 

[mersilen]

Halit bey uzun süredir aradığım bir kodu yazmışsınız, ellerinize sağlık.

Yalnız excelden html uzantılı bir dosya oluşturduğum zaman
excelde A22 deki saldırı metnini html dosyasından açarken sald�r� olarak yapıyor.Sanırım türkçe dil kodlaması sorunu oluşuyor.Çözümü hakkında fikriniz var mı?

 

[emnozdemir]

Teşekkür ederim Halit Hocam, Ellerinize sağlık.

 

[halit3]

Halit bey uzun süredir aradığım bir kodu yazmışsınız, ellerinize sağlık.

Yalnız excelden html uzantılı bir dosya oluşturduğum zaman
excelde A22 deki saldırı metnini html dosyasından açarken sald�r� olarak yapıyor.Sanırım türkçe dil kodlaması sorunu oluşuyor.Çözümü hakkında fikriniz var mı?

kodun bu bölümünü

Print #1, Worksheets("Txt Dosyası").Cells(i, 1).Value

bununla değiştirin

Print #1, Replace(Worksheets("Txt Dosyası").Cells(i, 1).Value, "ı", "i")

 

[halit3]

Teşekkür ederim Halit Hocam, Ellerinize sağlık.

İyi çalışmalar

 

[mersilen]

kodun bu bölümünü

Print #1, Worksheets("Txt Dosyası").Cells(i, 1).Value

bununla değiştirin

Print #1, Replace(Worksheets("Txt Dosyası").Cells(i, 1).Value, "ı", "i")

Halit bey teşekkürler

 

[halit3]

Halit bey teşekkürler

İyi çalışmalar