Dosya Sayacının Klasör içinde * ile başlayanlara göre artması

[hsayar]

Esenlikler,

Sub subhsr_Selection_ScreenShot()
'#########################################################################################################'
'#########         Aktif Çalışma Sayfasında seçili olan hücreleri ve üzerindeki                  #########'
'#########         grafik, resim vs. şekillerin resmini çekip c:\resim altına                    #########'
'#########         kaydeder.                                                                     #########'
'#########         [URL="http://www.Excel.web.tr"]www.Excel.web.tr[/URL] den Anemos ve Seyit Diken 'in katkılarıyla                   #########'
'#########         hsayar tarafından hazırlanmıştır.                                             #########'
'#########################################################################################################'
1 Dim DsSisKnt, Pic, graf, Dosyalar, dosya, ws, wb As Object
2 Dim KytKls$, uznKls$, KytDAd$, uznDAd$, ara$, sycDno%, Arlk
3 Set DsSisKnt = CreateObject("Scripting.FileSystemObject")
4 Set ws = Selection.Parent:         Set wb = ws.Parent
5 On Error GoTo hata
'\  Seçili Alanın resmini çeker;
6 Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture: GoTo islem
7 hata:
8    MsgBox "Birleşik aralıkta bir seçim yapmalısınız": GoTo Son
9 islem:
'**\     Çekilen resmi pic değişkenine atayarak yapıştır, sayfadan siler.
10        Set Pic = ActiveSheet.Pictures.Paste
11        With Pic
12      '      .Copy
13            .Delete
14        End With
15        Set Pic = Nothing
'**\     Resmin kaydedileceği klasör ve dosya adı ve uzunluk bilgileri hazırlanır.
16        KytKls = "C:\Resim\":           Call SubHsr_Klsr_Yks_Olstr(KytKls)
17        uznKls = Len(KytKls)
171       Arlk = "[" & Replace(Replace(Selection.address, ":", "_", 1), "$", "", 1) & "]_"
18        KytDAd = "[" & wb.Name & "-" & ws.Name & "]_" & Arlk:                                  uznDAd = Len(KytDAd)
'**\    Dizindeki Dosya Adlarını Kaydedilecek Dosya Adı ile karşılaştır...
19        Set Dosyalar = DsSisKnt.GetFolder(KytKls).Files
20        For Each dosya In Dosyalar
21            ara = Mid$(KytKls & KytDAd, uznKls + 1, uznDAd)
22            If ara = KytDAd Then sycDno = sycDno + 1
23        Next
24        Set Dosyalar = Nothing:                 Set dosya = Nothing
'**\    Çekilen Resmi, jpg olarak kaydet
25        Set graf = ActiveSheet.ChartObjects.Add(1, 1, Selection.Width + 2, Selection.Height + 2).Chart
251       KytDAd = KytKls & KytDAd & Format(sycDno + 1, "000") & ".jpg"
26        With graf
27            .Paste
28            .Export KytDAd
29            .Parent.Delete
30        End With
31        Set graf = Nothing
32 Son:
33    Set DsSisKnt = Nothing
34    Set ws = Nothing
End Sub
Sub SubHsr_Klsr_Yks_Olstr(YnKlsrYolu)
'Belirtilen yolda, Belirtile İsimde [(c:\aaaa\bbbb) gb.]Klasör var mı bak, yoksa oluştur.
1   Dim DsSisKnt As Object
2   Set DsSisKnt = CreateObject("Scripting.FileSystemObject")
3       If DsSisKnt.FolderExists(YnKlsrYolu) = False Then DsSisKnt.CreateFolder YnKlsrYolu
4   Set DsSisKnt = Nothing
End Sub

Yukarıdaki kodalr ile seçili hücrelerde çekilen resimler c:\resim klasörü altına
[kitapadı-Sayfaadı]-[Aralık]_Sayaç Nosu olarak kaydediliyor.
Ancak şekildende görüldüğü üzere
[vtmahbirimler.xls-ilveilce]_[E8_H21]_001.jpg sırası ile giderken
[vtmahbirimler.xls-ilveilce]_[D14_D27]_005.jpg bu dosyaya geldiği zaman klasör içindeki dosya sayısından devam ediyor ancak ben 1 den tekrar başlamasını istiyorum.
Konunun çzöümü var mıdır?