Yazdırılan sayfayı text dosyasına aktarmak

[serdarinho43]

Arkadaşlar excel de bir sayfa yazdırdığım da sayfayı txt dosyası olarak F/:Çıktı sayfasına yazdırma saati ve tarihiyle atmasını istiyorum bunu nasıl yapabilirim hepinize şimdiden teşekkürler...

 

[serdarinho43]

Arkadaşlar bunu yapamaz mıyız yapazmıyorsak acı gerçeği saklamayın benden söyleyin

 

[Zeki Gürsoy]

Örnek dosya ekleyiniz.

 

[serdarinho43]

Örnek dosya ekleyiniz.

örnek dosya ektedir.

 

[Zeki Gürsoy]

ThisWorkbook:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Application.OnTime Now + _
        TimeSerial(0, 0, 2), "Print_Text"
End Sub

Module1:

Sub Print_Text()
Dim sat&, sut%, arr()
Dim x%, y&, z$

With ActiveSheet
sut = .[a1].CurrentRegion.Columns.Count
sat = .[a1].CurrentRegion.Rows.Count

ReDim arr(sut - 1)

Open "F:\Çıktı\" & _
    Format(Now, "yyyymmdd" & "_" & "hhss" & ".txt") For Output As #1
    
    For y = 1 To sat
    
        For x = 1 To sut
            arr(x - 1) = .Cells(y, x)
        Next
        
        z = Join(arr, ";")
        
        Print #1, z
        
    Next

Close #1

End With

Erase arr

End Sub

 

[serdarinho43]

ThisWorkbook:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Application.OnTime Now + _
        TimeSerial(0, 0, 2), "Print_Text"
End Sub

Module1:

Sub Print_Text()
Dim sat&, sut%, arr()
Dim x%, y&, z$

With ActiveSheet
sut = .[a1].CurrentRegion.Columns.Count
sat = .[a1].CurrentRegion.Rows.Count

ReDim arr(sut - 1)

Open "F:\Çıktı\" & _
    Format(Now, "yyyymmdd" & "_" & "hhss" & ".txt") For Output As #1
    
    For y = 1 To sat
    
        For x = 1 To sut
            arr(x - 1) = .Cells(y, x)
        Next
        
        z = Join(arr, ";")
        
        Print #1, z
        
    Next

Close #1

End With

Erase arr

End Sub

syn Zeki GÜRSOY
yazdığınız kod işe yaradı: C:/Çıktı ya atınca oluyor ancak txt F:/Çıktı attığım zaman olmuyor Bunun nedeni F'in flash disk olması olabilir mi

 

[Zeki Gürsoy]

Flash diskinizde "Çıktı" isminde klasör olduğundan emin misiniz?

 

[serdarinho43]

çok teşekkürler bu işlemi yaptım ama txt dosyasını excel pormatında açtığım zaman eski haliyele açılmıyor sıralar ve tablolar değişiyor bnun nedeni nedir??

 

[Zeki Gürsoy]

Veri > Metni Sütunlara Dönüştür komutunu verin ve sihirbazın ikinci adımında ayracı ";" noktalı virgül olarak belirleyin. Sütunlara dağılacaktır.

 

[tatar7]

sutun genişliği

peki ustat sutun genişliğini ayarlayabilirmiyiz. örn: a4 sutunu 10 karakter olsa dahi 5 karakter - b4 sutunu 2 karakter olsa dahi 9 karakter 6 karakterini boşluk gibi yani txt ye aktarılan sutunun karakter uzunluğunu biz belirleye bilirmiyiz.
değerli bilgi ve fikirleriniz ve paylaşımınız için şimdiden teşekkur ediyorum

 

[Zeki Gürsoy]

peki ustat sutun genişliğini ayarlayabilirmiyiz. örn: a4 sutunu 10 karakter olsa dahi 5 karakter - b4 sutunu 2 karakter olsa dahi 9 karakter 6 karakterini boşluk gibi yani txt ye aktarılan sutunun karakter uzunluğunu biz belirleye bilirmiyiz.
değerli bilgi ve fikirleriniz ve paylaşımınız için şimdiden teşekkur ediyorum

Elbette. Kullanıcı tanımlı tip (type) kullanarak kolayca yapılabilir. Aşağıdaki kodu deneyerek/değiştirerek sonucu gözlemleyin.

Type bilgiler
    adı As String * [B]50[/B]
    soyadı As String * [B]70[/B]
End Type

Dim textdata As bilgiler

Sub test()
textdata.adı = "excel"
textdata.soyadı = "web.tr"

Open "c:\test.txt" For Output As #1
    Print #1, textdata.adı; textdata.soyadı
Close #1
End Sub

 

[serdarinho43]

çok teşekkürler gerçekten çokk yararlı bir konu oldu eline sağlık

 

[tatar7]

tşk

sayın Zeki Gürsoy üstad çok teşekkür ediyorum kolay gelsin