Odeme Listesi Hazirlama

[mustafaine1]

Merhaba arkadaslar, sanirim biraz zor bir dosyam var, ekteki dosyada 3 ayri sayfa var..

Odeme Plani, banka adi ve odeme gunu bulunuyor.. Istegim ise Odeme planinda bankalari listten sectikten sonra olusturulmus olan 02.03.10 isimli dosyanin kendiliginden olusmasi bu yapilabilirmi acaba?

 

[muratalsu]

makro yapmayı denedinmi? bu tür işlemler makroyla yapılabilir diye düşünüyorum....

 

[mustafaine1]

o yuzden vba bolumune actim konuyu ama

 

[murat23351]

arkadaşım okul için yapmış olduğum ekders puantajında depolama olarak kullandığım yöntem sizin işinize yarar umarım.... çalışma mantığı istediğiniz hücre isimlerini tanımlayıp gösterin yola yani kaynak yola makroyuda atayınız... ve kayıt yolunuda istediğiniz gibi değiştiriniz... banka isminde istediğiniz tarihde dosyanız mevcut olacaktır..

Sub KADkayitet()
KADROTIPI = Cells(98, "AP").Value
CIZGI = Cells(97, "AP").Value
YIL = Cells(94, "AL").Value
AY = Cells(93, "AL").Value
OKULADI = Cells(94, "H").Value '& ".xls"
Sayfa_adi = "KADROLU"
On Error Resume Next
Kaynak = "D:\EKDERS\" & YIL & CIZGI & AY & CIZGI & KADROTIPI
If Dir("D:\EKDERS\") = "" Then MkDir ("D:\EKDERS\")
If Dir(Kaynak) = "" Then MkDir (Kaynak)
On Error Resume Next
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(Kaynak & "\" & OKULADI & ".xls")
If a = True Then
MsgBox "Bu isimde bir dosya var"
Exit Sub
Else
End If
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_adi Then
sayfa.Copy
vbprojectsil
'ActiveSheet.DrawingObjects.Delete
nesne_sil
ActiveWorkbook.SaveAs Kaynak & "\" & OKULADI & ".xls"
ActiveWorkbook.Close False
Exit Sub
End If
Next sayfa
End Sub
Sub vbprojectsil()
For Each component In ActiveWorkbook.VBProject.VBComponents
If component.Type <> 100 Then
ActiveWorkbook.VBProject.VBComponents.Remove component
Else
Set modul = component.CodeModule
modul.DeleteLines 1, modul.CountOfLines
End If
Next
End Sub
Sub nesne_sil()
Dim Picture As Object, Bak As String, Uzunluk As Byte
Bak = "AutoShape"
Uzunluk = Len(Bak)
For Each Picture In ActiveSheet.Shapes
If Mid(Picture.Name, 1, Uzunluk) = Bak Then
Picture.Delete
End If
Next Picture
End Sub

bu kodlarla demek istediğini böyle yaptım ama benimde bu dosyadan sıkıntılarım var eksik kalan yanları var... bu konuda yardımda bulunursanız sevinirim
http://www.excel.web.tr/showthread.php?p=446545#post446545

 

[mustafaine1]

Ben bunlarla yapabilcek olsam sitede bir cok calisma bulurum sanirim..

 

[murat23351]

tamam bunları yapabiliyorsan şayet makro yu otomatik çalıştırmasını bilirisin o zaman....

 

[mustafaine1]

Anlamamak icin mi ugrasiyorsunuz, bir seferlik evet fakat benim normalde daha fazla bankam var yahut daha fazla odeme duzenlemem gerekebilir ki gerekiyor bunun orada yazanlari copy paste etmesine degil belirli kistasa gore aldirmasina ihtiyacim var..