Aşağıdaki kodu Masaüstüne kopyalayacak şekilde düzenleyebilirmisiniz.

[ferhatgurbuz]

Sub disketyaz()
sat = 11
sayac = 0
yer = Worksheets(ActiveSheet.Name).Cells(4, 3).Value
dosyaad = yer + Format(Str(Worksheets(ActiveSheet.Name).Cells(5, 3).Value), "000") + Mid(Worksheets(ActiveSheet.Name).Cells(6, 3).Value, 1, 2) + Worksheets(ActiveSheet.Name).Cells(8, 3).Value + ".txt"
Open dosyaad For Output As #1
alan1 = Format(Str(Worksheets(ActiveSheet.Name).Cells(5, 3).Value), "000")
alan2 = Mid(Worksheets(ActiveSheet.Name).Cells(6, 3).Value, 1, 2)
alan5 = Format(Str(Worksheets(ActiveSheet.Name).Cells(7, 3).Value), "00")
alan7 = Worksheets(ActiveSheet.Name).Cells(8, 3).Value
While Not IsEmpty(Worksheets(ActiveSheet.Name).Cells(sat, 2).Value)
alan3 = "0015800" + Trim(Worksheets(ActiveSheet.Name).Cells(sat, 2).Value)
alan4 = Worksheets(ActiveSheet.Name).Cells(sat, 3).Value
n4 = Len(Trim(alan4))
If n4 < 12 Then
alan4 = Trim(alan4) + Space(12 - n4)
End If
alan6 = Format(Worksheets(ActiveSheet.Name).Cells(sat, 4).Value)
alan6 = Format(alan6, "000000000000000.00")
n = InStr(alan6, ",")
If n > 0 Then
alan6 = Mid(alan6, 1, n - 1) & "." & Mid(alan6, n + 1, 2)
End If
sat = sat + 1
Print #1, alan1 & alan2 & alan3 & alan4 & alan5 & alan6 & alan7
sayac = sayac + 1
Wend
MsgBox " Kurum disketi oluştu toplam " + Str(sayac) + " kişi bilgisi diskete aktarıldı"
Close #1
End Sub

 

[Recep İpek]

C4 h&#252;cresine a&#351;a&#287;&#305;daki yolu yazarak deneyebilirmisiniz?

C:\Documents and Settings\Kendi Kullan&#305;c&#305; Ad&#305;n&#305;z\Desktop

 

[ferhatgurbuz]

te&#351;ekk&#252;r ederim say&#305;n Ripek