• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excelden E-Bildirge için Txt Dosyası Hazırlama

Ömer bey teşekkür ederim. Bu var bende zaten. Orda txt yükleme olayı var. Ben o txt formatına dönüştürecek kod arıyorum.

Yani bordrodaki ilgilii değerleri txt atayacak. Ve bu atanan ilgili değerler xls2xmly tarafından çekildiğinde tüm sigorta bilgileri primleri yüklenecek.
 
Şu kodlar txt dosyasından verileri çekiyor

Bunu çektiği txt dosyasını yaratmak istiyorum.


Kod: 
Sub TxtDosyaYukle5510()
   On Error Resume Next
   Range("C" & Mid$(Str(SigBasSatir), 2)).Select
   RowInd = SigBasSatir
   While ActiveCell.Value <> ""
       RowInd = RowInd + 1
       ActiveSheet.Range("C" & Mid$(Str(RowInd), 2)).Select
   Wend
   RowInd = RowInd - 1
   If RowInd > SigBasSatir Then
      Range("C" & Mid$(Str(SigBasSatir), 2) & ":Q" & Mid$(Str(RowInd), 2)).Select
      Selection.ClearContents
   End If
   Dim TxtSatir As String
   Open ActiveSheet.Range("J5").Value For Input As #2
   Err = 0
'Bordro Baslık Bilgileri Okunuyor
   Input #2, TxtSatir
   Cells(2, 5) = Trim$(Mid$(TxtSatir, 1, 21))
   Cells(2, 8) = Trim$(Mid$(TxtSatir, 23, 2))
   Cells(3, 5) = Trim$(Mid$(TxtSatir, 26, 3))
   Cells(4, 5) = Trim$(Mid$(TxtSatir, 30, 50))
   Cells(5, 5) = Trim$(Mid$(TxtSatir, 81, 50))
   Cells(6, 5) = Trim$(Mid$(TxtSatir, 132, 14))
   Cells(8, 5) = Trim$(Mid$(TxtSatir, 147, 4))
   Cells(9, 5) = Trim$(Mid$(TxtSatir, 152, 2))
   Cells(10, 5) = Trim$(Mid$(TxtSatir, 155, 1))
'Sigortalı Baslık Bilgileri Okunuyor
   Err = 0
   ind = SigBasSatir
   While Err = 0
       Input #2, TxtSatir
       If Err = 0 Then
            Cells(ind, 3) = Trim$(Mid$(TxtSatir, 1, 2)) 'bturu
            Cells(ind, 4) = Trim$(Mid$(TxtSatir, 4, 5)) 'kanun
            'Cells(ind, 5) = Trim$(Mid$(TxtSatir, 10, 13))
            Cells(ind, 5) = "" ' ssksicil
            Cells(ind, 6) = Trim$(Mid$(TxtSatir, 10, 11)) 'tckno
            Cells(ind, 7) = Trim$(Mid$(TxtSatir, 22, 18)) 'ad
            Cells(ind, 8) = Trim$(Mid$(TxtSatir, 41, 18)) 'sad
            Cells(ind, 9) = Trim$(Mid$(TxtSatir, 60, 18)) 'isad
            Cells(ind, 10) = Trim$(Mid$(TxtSatir, 79, 18)) 'ücret
            Cells(ind, 11) = Trim$(Mid$(TxtSatir, 98, 18)) ' ikramiye
            Cells(ind, 12) = Trim$(Mid$(TxtSatir, 117, 2)) ' gun
            Cells(ind, 13) = Trim$(Mid$(TxtSatir, 120, 4)) ' gg
            Cells(ind, 14) = Trim$(Mid$(TxtSatir, 125, 4)) ' cg
            Cells(ind, 15) = Trim$(Mid$(TxtSatir, 130, 2)) ' eksik gun
            Cells(ind, 16) = Trim$(Mid$(TxtSatir, 133, 2)) ' egn
            Cells(ind, 17) = Trim$(Mid$(TxtSatir, 136, 2)) ' icn
            Cells(ind, 18) = Trim$(Mid$(TxtSatir, 139, 9)) ' MESLEK KOD
            Cells(ind, 19) = Trim$(Mid$(TxtSatir, 148, 1)) ' ÇALIŞTI MI
       End If
       ind = ind + 1
   Wend
   Close #2
End Sub
'11
 
Örnek dosya ekliyorum.. İçinde açıklama yapıldı. Sarı alanlara veri girişi yapıldıktan sonra buton ile txt oluşturacak.
 

Ekli dosyalar

Merhaba.

Elimizde, son eklediğiniz kod'un veri çektiği txt belge örneği olsaydı daha hızlı sonuca ulaşılırdı diye düşünüyorum.
Kodlardan anladığım; excel belgesinin 14'üncü satırdan sonraki kısmı,
herbir satır sırasıyla, 2/5/BOŞ/11/18/18/18/18/18/2/4/4/2/2/2/9/1 olmak üzere
134 karakterden oluşacak
(her bir hücredeki veri uzunluğu, öngörülen karakter sayısından azsa verilerin sağına veya soluna
boşluk karakteri eklenerek eksikler tamamlanması gerekir
ya da excel belgesinde VERİ DOĞRULAMA özelliklerini kullanarak hücre içerisindeki
veri uzunluklarını istenilen karakter sayısı kadar olmaya zorlamak, koşula uyulmadığında
işlemlerin kesilmesini sağlamak gibi şeyler düşünülebilir.)
şekilde bir txt metin dosyası ortaya çıkacak.

Sorunsuz veri alınabilen bir örnek txt belge olursa sonuca ulaşılır diye düşündüğümü tekrar belirtmek isterim.

Kolay gelsin.
.
 
Son düzenleme:
Birazdan son versiyona göre txt göndereceğim.
 
Son düzenleme:
Örnek txt dosyası ektedir. Tüm sütunlara örnek girdim.. txt dosyasını ona göre işledim.
Burdaki txt dosyasını excelden yaratmak istiyorurm..
 

Ekli dosyalar

Son düzenleme:
Merhaba.

Aşağıdaki kod'u dener misiniz?
Eklediğiniz txt belgesinin aynısını oluşturması lazım.

Kod excel belgesinin bulunduğu klasöre txt uzantılı belge oluşturur.
Belgenin yolu ve adı excel belgesinde J5 hücresine yazılır.
.
Kod: 
[FONT="Arial Narrow"]Sub SGK_TXT()
Set WF = Application.WorksheetFunction
isim1 = "bordro"
isim2 = Format(Date, "dd_mm_yyyy")
yol = ActiveWorkbook.Path

Open yol & "\" & isim1 & "." & isim2 & ".txt" For Output As #1
'1 - 21.....23 - 2 /// 26 - 3 /// 30 - 50 /// 81 - 50 /// 132 - 14 /// 147 - 4 /// 152 - 2 /// 155 - 1
eiki = Cells(2, 5): If Len(Cells(2, 5)) < 21 Then eiki = Cells(2, 5) & WF.Rept("0", 21 - Len(Cells(2, 5)))
hiki = Cells(2, 8): If Len(Cells(2, 8)) < 2 Then hiki = Cells(2, 8) & WF.Rept("0", 2 - Len(Cells(2, 8)))
euc = Cells(3, 5): If Len(Cells(3, 5)) < 3 Then euc = Cells(3, 5) & WF.Rept("0", 3 - Len(Cells(3, 5)))
edort = Cells(4, 5): If Len(Cells(4, 5)) < 50 Then edort = Cells(4, 5) & WF.Rept(" ", 50 - Len(Cells(4, 5)))
ebes = Cells(5, 5): If Len(Cells(5, 5)) < 50 Then ebes = Cells(5, 5) & WF.Rept(" ", 50 - Len(Cells(5, 5)))
ealti = Cells(6, 5): If Len(Cells(6, 5)) < 14 Then ealti = Cells(6, 5) & WF.Rept(" ", 14 - Len(Cells(6, 5)))
esekiz = Cells(8, 5): If Len(Cells(8, 5)) < 4 Then esekiz = Cells(8, 5) & WF.Rept("0", 4 - Len(Cells(8, 5)))
edokuz = Cells(9, 5): If Len(Cells(9, 5)) < 2 Then edokuz = WF.Rept("0", 2 - Len(Cells(9, 5))) & Cells(9, 5)
eon = Cells(10, 5): If Len(Cells(10, 5)) < 1 Then eon = Cells(10, 5) & WF.Rept(" ", 1 - Len(Cells(10, 5)))
ust = eiki & " " & hiki & " " & euc & " " & edort & " " & ebes & " " & ealti & " " & esekiz & " " & edokuz & " " & eon
Print #1, ust

son = [C65536].End(3).Row: sut = 3   '2/5/11/18/18/18/18/18/2/4/4/2/2/2/9/1
For sat = 14 To son
c = Cells(sat, sut): If Len(Cells(sat, sut)) < 2 Then c = Cells(sat, sut) & WF.Rept(" ", 2 - Len(Cells(sat, sut)))
d = Cells(sat, sut + 1): If Len(Cells(sat, sut + 1)) < 5 Then d = Cells(sat, sut + 1) & WF.Rept(" ", 5 - Len(Cells(sat, sut + 1)))
f = Cells(sat, sut + 3): If Len(Cells(sat, sut + 3)) < 11 Then f = Cells(sat, sut + 3) & WF.Rept(" ", 11 - Len(Cells(sat, sut + 3)))
g = Cells(sat, sut + 4): If Len(Cells(sat, sut + 4)) < 18 Then g = Cells(sat, sut + 4) & WF.Rept(" ", 18 - Len(Cells(sat, sut + 4)))
h = Cells(sat, sut + 5): If Len(Cells(sat, sut + 5)) < 18 Then h = Cells(sat, sut + 5) & WF.Rept(" ", 18 - Len(Cells(sat, sut + 5)))
i = Cells(sat, sut + 6): If Len(Cells(sat, sut + 6)) < 18 Then i = Cells(sat, sut + 6) & WF.Rept(" ", 18 - Len(Cells(sat, sut + 6)))
j = Cells(sat, sut + 7): If Len(Cells(sat, sut + 7)) < 18 Then j = Cells(sat, sut + 7) & WF.Rept(" ", 18 - Len(Cells(sat, sut + 7)))
k = Cells(sat, sut + 8): If Len(Cells(sat, sut + 8)) < 18 Then k = Cells(sat, sut + 8) & WF.Rept(" ", 18 - Len(Cells(sat, sut + 8)))
l = Cells(sat, sut + 9): If Len(Cells(sat, sut + 9)) < 2 Then l = Cells(sat, sut + 9) & WF.Rept(" ", 2 - Len(Cells(sat, sut + 9)))
m = Cells(sat, sut + 10): If Len(Cells(sat, sut + 10)) < 4 Then m = Cells(sat, sut + 10) & WF.Rept(" ", 4 - Len(Cells(sat, sut + 10)))
n = Cells(sat, sut + 11): If Len(Cells(sat, sut + 11)) < 4 Then n = Cells(sat, sut + 11) & WF.Rept(" ", 4 - Len(Cells(sat, sut + 11)))
o = Cells(sat, sut + 12): If Len(Cells(sat, sut + 12)) < 2 Then o = Cells(sat, sut + 12) & WF.Rept(" ", 2 - Len(Cells(sat, sut + 12)))
p = Cells(sat, sut + 13): If Len(Cells(sat, sut + 13)) < 2 Then p = Cells(sat, sut + 13) & WF.Rept(" ", 2 - Len(Cells(sat, sut + 13)))
q = Cells(sat, sut + 14): If Len(Cells(sat, sut + 14)) < 2 Then q = Cells(sat, sut + 14) & WF.Rept(" ", 2 - Len(Cells(sat, sut + 14)))
r = Cells(sat, sut + 15): If Len(Cells(sat, sut + 15)) < 9 Then r = Cells(sat, sut + 15) & WF.Rept(" ", 9 - Len(Cells(sat, sut + 15)))
s = Cells(sat, sut + 16): If Len(Cells(sat, sut + 16)) < 1 Then s = Cells(sat, sut + 16) & WF.Rept(" ", 1 - Len(Cells(sat, sut + 16)))
metin = c & " " & d & " " & f & " " & g & " " & h & "  " & i & j & " " & k & " " & l & " " & m & " " & n & " " & o & " " & p & " " & q & r & " " & s
Print #1, metin

Next: Close
Range("J5") = yol & "\" & isim1 & "." & isim2 & ".txt"
MsgBox "İşlem Tamam.." & vbLf & _
        isim1 & "." & isim2 & ".txt" & vbLf & _
        " İSİMLİ BELGE EXCEL BELGESİNİN BULUNDUĞU KLASÖRE KAYDEDİLDİ.", vbInformation, "BARAN"
End Sub[/FONT]
 
Son düzenleme:
Sayın Ömer bey,

Gerçekten elinize sağlık. O kadar zahmet edip uğraşmışsınız. Tam istediğim gibi olmuş Allah sizden razı olsun.. Çok çok teşekkür ederim..Harika oldu bu..
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst