- Katılım
- 24 Şubat 2009
- Mesajlar
- 1,077
- Excel Vers. ve Dili
- 2016
Evet denedim Halit bey aynı hatayı verdi herzaman o söylediğim yerde duruyor.
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Evet denedim Halit bey aynı hatayı verdi herzaman o söylediğim yerde duruyor.
kaynak = "D:\Belgelerim\Banka\"
D:\Documents and Settings\Administrator\Belgelerim\Banka\
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
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