Merhaba arkadaşlar, excelde BABS bildirge formatına göre hazırlanmış tabloyu sekmelere ayrılmış txt olarak atan kodumu sizinle paylaşıyorum. Bu doğrudan xml oluşturmaz ancak bununla exceldeki çalışmayı seri şekilde sekmelere ayrılmış txt olarak kaydedebilirsiniz.

Bu kodu excelin geliştirici sekmesinden ekleyeceğiniz butonun içinde yazabilirsiniz.

Private Sub babs_txt_Click()
debug1.Clear
Dim fNum1, stn, sr, i, ino As Integer
Dim outFile, gd, d(4), s(0) As String
Dim deger As Variant
Dim os As Object
Set os = CreateObject("wscript.shell")
gd = os.specialfolders("desktop")
Set os = Nothing
Dim adi As String
adi = InputBox("dosya adını giriniz!")

'Open file
outFile = gd & "\" & IIf(adi = "", "BABS", adi) & ".txt"
fNum1 = FreeFile()
Open outFile For Output As fNum1

'loop through non-blanks
stn = InputBox("İlk Sütun No")
i = InputBox("ilk Satır No")
If (stn = "" Or stn = 0) Then
stn = 1
Else
stn = stn
End If

If (i = "" Or i = 0) Then
i = 1
Else
i = i
End If


stn = stn * 1
i = i * 1
ino = i - 1
If stn = 0 Or i = 0 Then
debug1.AddItem "İşlem iptal edildi."
Exit Sub
End If
debug1.AddItem "İşlem başladı."
With ActiveSheet

Do Until .Cells(i, stn + 1) = ""
d(0) = 0
d(0) = Application.WorksheetFunction.RoundDown(.Cells(i, (stn * 1) + 6).Value, 0)
Dim x, t As Integer
For t = 1 To 2
For x = 1 To Len(d(t - 1))
If Mid(d(t - 1), x, 1) = "." Then
d(t - 1) = " " & Left(d(t - 1), x - 1) & "," & Right(d(t - 1), Len(d(t - 1)) - x)
Exit For
Else
d(t - 1) = d(t - 1)
End If
Next

Next
Print #fNum1, i & vbTab & Left(Trim(.Cells(i, stn + 1).Value), 60) & vbTab & .Cells(i, stn + 2).Value & vbTab & .Cells(i, stn + 3).Value & vbTab & .Cells(i, stn + 4).Value & vbTab & .Cells(i, stn + 5).Value & vbTab & d(0)
i = i + 1
sr = sr + 1
debug1.AddItem sr & " / " & Range(Cells(65536, stn + 1), Cells(65536, stn + 1)).End(xlUp).Row - ino
Loop
End With
debug1.AddItem "İşlem tamamlandı."
'All done
Close #fNum1
End Sub