Zirve muhasebeci paketinden Netle e-defter uygulamasına dönüşüm yapmak için aşağıdaki excel macro kod yardımcınız olabilir.
İlgili paketten ilgili döneme ilişkin "fiş listesi" excel ortamına aktarılır. excel dosyası açılır ve ikinci sheet olarak "netle" adında bir boş sayfa eklenir.
macro kodlarına aşağıdaki kod eklenir ve excel macro calistir yardımı ile "Netle-Defter" formatlarına uygun çıktı alınabilir.
NotBuradaki kodlar örnek veri modeli için hazırlanmıştır. Her veride kesin ve tutarlı sonuçlar vermesi beklenmemektedir. transfer aşamasında yardımcı olması adına tasarlanmıştır.
Sub NetleOlarakDuzenle()
'tum fisleri gez ve netle ortamına aktar
Dim newIndex As Integer
Dim lastFisNo As String
Dim lastFisTar As String
Dim lastEntryComment As String
Dim borc As Double
Dim alacak As Double
Dim itemDesc As String
Dim ht
Dim dt
Set ht = CreateObject("System.Collections.Hashtable")
Set dt = CreateObject("System.Collections.Hashtable")
' j=1 : odeme turleri fis bazında belirleniyor...
' j=2 : belirlenen odeme turleri yerine yazılıyor
For J = 1 To 2
newIndex = 2
For I = 1 To 7000
If (Sheet1.Cells(I, 11) = "Fiş Tarihi :") Then
lastFisTar = Sheet1.Cells(I, 12) & Sheet1.Cells(I, 13)
lastEntryComment = Sheet1.Cells(I - 2, 4) & Sheet1.Cells(I - 2, 5) & Sheet1.Cells(I - 2, 6) & Sheet1.Cells(I - 2, 7)
If (lastEntryComment = "") Then
lastEntryComment = Sheet1.Cells(I - 1, 4) & Sheet1.Cells(I - 1, 5) & Sheet1.Cells(I - 1, 6) & Sheet1.Cells(I - 1, 7)
End If
End If
If (Sheet1.Cells(I, 11) = "Fiş No :") Then
lastFisNo = Right("00000000" & Sheet1.Cells(I, 12) & Sheet1.Cells(I, 13), 8)
End If
heskod = Sheet1.Cells(I, 2)
testPos = InStr(1, heskod, "-")
If (heskod > "" And testPos > 0) Then
If (J = 1) Then
If (Left(heskod, 3) = "100") Then
If (CStr(ht(lastFisNo)) = "") Then
ht(lastFisNo) = "Nakit"
Else
ht(lastFisNo) = "" 'daha onceden bulunan degeri sıfırla, aynı anda iki odeme turu olamaz
End If
End If
If (Left(heskod, 3) = "102") Then
If (CStr(ht(lastFisNo)) = "") Then
ht(lastFisNo) = "Banka"
Else
ht(lastFisNo) = "" 'daha onceden bulunan degeri sıfırla, aynı anda iki odeme turu olamaz
End If
End If
If (Left(heskod, 3) = "309") Then
If (CStr(ht(lastFisNo)) = "") Then
ht(lastFisNo) = "KrediKarti"
Else
ht(lastFisNo) = "" 'daha onceden bulunan degeri sıfırla, aynı anda iki odeme turu olamaz
End If
End If
End If
borc = Sheet1.Cells(I, 11)
alacak = Sheet1.Cells(I, 12) + Sheet1.Cells(I, 13) + Sheet1.Cells(I, 14)
itemDesc = Sheet1.Cells(I, 7) & Sheet1.Cells(I, 8)
Dim abc() As String
abc = Split(itemDesc, "-")
ub = UBound(abc)
'detail comment hazırlanıyor
If (ub > 3) Then
dts = ""
For uindex = 3 To ub
dts = dts & " " & abc(uindex)
Next
Sheet2.Cells(newIndex, 16) = dts
End If
If (ub = 3) Then
Sheet2.Cells(newIndex, 16) = abc(3)
End If
If (ub = 2) Then
Sheet2.Cells(newIndex, 16) = abc(2)
End If
'dokuman turu anlasiliyor
If (J = 1 And itemDesc > "") Then
sourceDT = abc(0)
aktifdt = CStr(dt(lastFisNo))
currDt = ""
If (sourceDT = "Fatura") Then
currDt = "Invoice"
End If
If (sourceDT = "Banka Ekstresi") Then
currDt = "Other"
End If
If (sourceDT = "Makbuz") Then
currDt = "Receipt"
End If
If (sourceDT = "Uc.Bord.") Then
currDt = "Other"
End If
If (currDt > "") Then
If (currDt = "Other" Or currDt = "Invoice" Or currDt = "Check") Then
If (ub > 3) Then
Sheet2.Cells(newIndex, 14) = "'" & abc(2)
Sheet2.Cells(newIndex, 15) = CDate(abc(1))
End If
If (ub = 3) Then 'doctype+tar+no
Sheet2.Cells(newIndex, 14) = "'" & abc(2)
Sheet2.Cells(newIndex, 15) = CDate(abc(1))
End If
If (ub = 2) Then 'doctype+no
If (InStr(1, abc(1), ".") > 0) Then
Sheet2.Cells(newIndex, 15) = CDate(abc(1))
Else
Sheet2.Cells(newIndex, 14) = "'" & abc(1)
End If
End If
'dokuman tarihi halen boş ise, yevmiye tarihi ile aynı giriş yap
If (Sheet2.Cells(newIndex, 15) = "") Then
Sheet2.Cells(newIndex, 15) = CDate(lastFisTar)
End If
End If
If (aktifdt = "") Then
dt(lastFisNo) = currDt
Else
If (aktifdt <> currDt) Then
Err.Raise vbObjectError + WidthErrorNumber, "", "aynı fis icinde iki tur dokuman var - " & lastFisNo
End If
End If
End If
End If
Sheet2.Cells(newIndex, 1) = "Murat Yetkin"
Sheet2.Cells(newIndex, 2) = CDate(lastFisTar)
Sheet2.Cells(newIndex, 3) = CDate(lastFisTar)
Sheet2.Cells(newIndex, 4) = "Mahsup"
Sheet2.Cells(newIndex, 5) = "'" & lastFisNo
Sheet2.Cells(newIndex, 6) = lastEntryComment
Sheet2.Cells(newIndex, 7) = heskod
Sheet2.Cells(newIndex, 8) = "TRL"
Sheet2.Cells(newIndex, 9) = borc + alacak
If (borc > 0) Then
Sheet2.Cells(newIndex, 10) = "D"
Else
Sheet2.Cells(newIndex, 10) = "C"
End If
If (J = 2) Then
odemeTuru = CStr(ht(lastFisNo))
If (odemeTuru > "" And lastEntryComment <> "Açılış Fişi") Then
Sheet2.Cells(newIndex, 11) = "'" & odemeTuru
End If
dstr = CStr(dt(lastFisNo))
If (dstr > "") Then
Sheet2.Cells(newIndex, 12) = dstr
End If
If dstr = "Other" Then
Sheet2.Cells(newIndex, 13) = abc(0)
End If
End If
Sheet2.Cells(newIndex, 17) = "'" & Sheet1.Cells(I, 4)
newIndex = newIndex + 1
End If
Next
Next
End Sub