Text Oluşturma (Çalışma kitabının her sayfası için ayrı text nasıl yapılır)

[dortmevsim]

Arkadaşlar iki gündür denemediğim yol kalmadı işin acemisine çok zor geliyor İnşallah sizden bir cevap gelir. Örnekte gerekli açıklamaları yaptım benim istediğim Excel çalışma kitabının bir sütununu text dosyası haline getirme fakat çalışma kitabının her sayfası için ayrı bir text dosyası oluşacak oluşan dosyalarda o sayfanın adını alacak. Oluşan text dosyalarıda çalışma kitabının adını alacak bir klasör içinde toplanacak örneğe bakarsanız çok sevinirim şimdiden teşekkürler.

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları, standart bir modül sayfasına kopyalayıp çalıştırınız.

Sub Text_Dosya_Yarat()
Dim FSO As Object
Dim klasor As Object
Dim dizin As String
Dim sh As Worksheet
Dim i As Integer
Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
If klasor Is Nothing Then
    MsgBox "Herhangi bir klasör seçmediniz", vbCritical, "UYARI"
Else
    dizin = klasor.Items.Item.Path
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(dizin & "\" & Replace(ThisWorkbook.Name, ".xls", "")) Then
        MsgBox "Bu isimde bir klasör zaten var", vbCritical, "UYARI"
        Exit Sub
Else
        FSO.CreateFolder dizin & Application.PathSeparator & Replace(ThisWorkbook.Name, ".xls", "")
 
        For Each sh In ThisWorkbook.Worksheets
            With FSO.CreateTextFile(dizin & Application.PathSeparator & Replace(ThisWorkbook.Name, ".xls", "") & Application.PathSeparator & sh.Name & ".txt")
                 For i = 3 To sh.Cells(65536, 6).End(xlUp).Row
                     If sh.Cells(i, 6) <> Empty Then
                        .writeline sh.Cells(i, 6)
                     End If
                 Next i
                 .Close
            End With
        Next
End If
Set FSO = Nothing
Set klasor = Nothing
End Sub

 

[dortmevsim]

Çok teşekkürler tam istediğim gibi yanlız;

081542L;000000028,60 şeklinde atıyor
081542L;000000028.60 bu şekilde nasıl yaparız.(virgül nokta olacak)

 

[Ferhat Pazarçevirdi]

Şu satırı :

                         .writeline sh.Cells(i, 6)

Şu şekilde :

                        .writeline Replace(sh.Cells(i, 6), ",", ".")

değiştiriniz.

 

[dortmevsim]

Gerçekten çok güzel bir çalışma oldu elinize sağlık teşekkürler.