• DİKKAT

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

Banka Listesi Olusturma

Evet denedim Halit bey aynı hatayı verdi herzaman o söylediğim yerde duruyor.

kodun içindeki dosyanın kayıt yeri doğrumu ?

sizdeki belgelerim banka klasörü böyle

Kod:
kaynak = "D:\Belgelerim\Banka\"

bendeki belgelerim içinde banka klasörü böyle

Kod:
D:\Documents and Settings\Administrator\Belgelerim\Banka\

mesajımı son kez yazıyorum. aşağıdaki kodu deneyin kod dosyanın hemen yanına yeni dosya oluşturuyor.

görsel videoyuda ekliyorum.

görsel video


Kod:
Sub yeni_dosya_oluştur()
'On Error Resume Next

kaynak = ThisWorkbook.Path & "\"

Application.DisplayAlerts = False

ay = Format(Now, "mmmm")
yıl = Format(Now, "yyyy")

dosya_adı = InputBox("Dosyanın adını yazınız", "UYARI", ay & " KESİNTİSİ " & yıl)

If dosya_adı = "" Then
MsgBox "Sayfa ismini yazmadınız"
Exit Sub
End If

kesinti = InputBox("kesinti nedeni", "UYARI", ay & " AYI KESİNTİSİ")

If kesinti = "" Then
MsgBox "Kesinti ayını yazınız Sayfa ismini yazmadınız"
Exit Sub
End If
Workbooks.Add

dosya = ActiveWorkbook.Name
sayfa_Adı = ActiveSheet.Name


For ii = ActiveWorkbook.Sheets.Count To 2 Step -1
ActiveWorkbook.Sheets(ii).Delete
Next


sat = 1
For i = 2 To ThisWorkbook.Worksheets("LİSTE").Cells(Rows.Count, "C").End(3).Row

ActiveWorkbook.Sheets(sayfa_Adı).Cells(sat, 1).Value = ThisWorkbook.Sheets("LİSTE").Cells(i, 3).Value & " " & ThisWorkbook.Sheets("LİSTE").Cells(i, 4).Value
ActiveWorkbook.Sheets(sayfa_Adı).Cells(sat, 4).Value = ThisWorkbook.Sheets("LİSTE").Cells(i, 11).Value
ActiveWorkbook.Sheets(sayfa_Adı).Cells(sat, 5).Value = ThisWorkbook.Sheets("LİSTE").Cells(i, 29).Value
ActiveWorkbook.Sheets(sayfa_Adı).Cells(sat, 6).Value = kesinti

sat = sat + 1
Next i

Columns("A:G").Columns("A:G").EntireColumn.AutoFit
Range("a1").Select
ActiveWorkbook.SaveAs kaynak & dosya_adı & ".xls"
ActiveWindow.Close
ActiveWindow.WindowState = xlMaximized

Application.DisplayAlerts = True
MsgBox "İşlem Tamam"


End Sub
 
Selamün Aleyküm arkadaşlar;
Halit beyin hazırladığı kodu dosyamda çalıştırdım, Bu koda nasıl bir ilave yapalım ki, dosya oluşturulduktan sonra bana oluşturulan dosyanın açılmasını sağlasın. Kod ekliyorum.
Kod:
Private Sub CommandButton1_Click()
kaynak = "D:\Belgelerim\Banka\"

Application.DisplayAlerts = False

ay = Format(Now, "MMMM")
yıl = Format(Now, "YYYY")

dosya_adı = InputBox("Dosyanın Adını Yazınız", "UYARI", ay & " KESİNTİSİ " & yıl)

If dosya_adı = "" Then
MsgBox "Sayfa İsmini Yazmadınız"
Exit Sub
End If

kesinti = InputBox("Kesinti Nedeni", "UYARI", ay & " AYI KESİNTİSİ")

If kesinti = "" Then
MsgBox "Kesinti Ayını Yazınız Sayfa İsmini Yazmadınız"
Exit Sub
End If
Workbooks.Add

dosya = ActiveWorkbook.Name
sayfa_Adı = ActiveSheet.Name


For ii = ActiveWorkbook.Sheets.Count To 2 Step -1
ActiveWorkbook.Sheets(ii).Delete
Next


SAT = 1
For i = 2 To ThisWorkbook.Worksheets("LİSTE").Cells(Rows.Count, "C").End(3).Row

ActiveWorkbook.Sheets(sayfa_Adı).Cells(SAT, 1).Value = ThisWorkbook.Sheets("LİSTE").Cells(i, 3).Value & " " & ThisWorkbook.Sheets("LİSTE").Cells(i, 4).Value
ActiveWorkbook.Sheets(sayfa_Adı).Cells(SAT, 4).Value = ThisWorkbook.Sheets("LİSTE").Cells(i, 11).Value
ActiveWorkbook.Sheets(sayfa_Adı).Cells(SAT, 5).Value = ThisWorkbook.Sheets("LİSTE").Cells(i, 29).Value
ActiveWorkbook.Sheets(sayfa_Adı).Cells(SAT, 6).Value = kesinti

SAT = SAT + 1
Next i

Columns("A:G").Columns("A:G").EntireColumn.AutoFit
Range("a1").Select
ActiveWorkbook.SaveAs kaynak & dosya_adı & ".xls"
ActiveWindow.Close
ActiveWindow.WindowState = xlMaximized

Application.DisplayAlerts = True

MsgBox " Kesinti için dosya oluşturdum, TOPLAM " + Str(SAT - 1) + " Kişinin Kesintisi bankaya gönderilmeye hazır. Dosya Açılsın Mı?", vbYesNo, "Merhaba Muhammet Ali GÜL"

'Burdaki kodda düzenleme olacak 
[COLOR="Red"][COLOR="Blue"]dosyaadi = "D:\Belgelerim\Banka\[COLOR="Red"]dosya[/COLOR].xls"[/COLOR][/COLOR]
CreateObject("Shell.Application").Open (dosyaadi)



End Sub
 
Son düzenleme:
Merhaba arkadaşlar, 23 numaralı mesajıma cevap verebilir misiniz?
Burada sorum şu, bu kodla yeni bir dosya D:\Belgelerim\Banka\ içerisinde oluşturuluyor, ancak alınan mesajdan sonra bu dosyanın direk açmasını istiyorum. teşekkürler.
 
Geri
Üst