Farklı Kaydet Makrosu

[akmlyx]

Merhaba Değerli Üstatlar,
Farklı kaydet makrosu ile ilgili yaptığım araştırmalar neticesinde bulduğum makrolar işimi çözmediği için sizleri bu konuda rahatsız ediyorum. Lütfen kusura bakmayın.
Sorunum:
Ekteki Excel'de butona bağlı olarak çalışacak makro, masaüstüne bir klasör açacak, bu klasörün adı "Bordro" sayfasındaki AA11 hücresinden alacak. Bu klasör açıldıktan sonra "Bordro" sayfasındaki B5 hücresine 1'den başlamak üzere sırasıyla 65'e kadar numara yazdıracak, yazılan her sayı için bordrodaki bilgiler otomatik olarak değiştiği zaman bordro sayfasında D2:X48 hücreleri(yazdırılabilir alanı) ".pdf" formatında belge oluşturulacak, bu belge ismini AA14 hücresinden alarak masaüstündeki açılmış klasörün içine kaydedecek. İlk belgenin kayıt işlemi bitince sonra B5 hücresine sıradaki sayı yazdırılarak (örneğin önce 1 yazılı ise birinci belge kaydedilince sonra 2 yazdırılacak ikinci belge kaydedilecek gibi) işlem 65'e kadar devam edecek.
Bu konuda yardımlarınıza çok ihtiyacım var. Şimdiden TEŞEKKÜR EDERİM.

 

[asi_kral]

Merhaba
boş bir module ekleyip dener misiniz?

Sub kayıtlar()
Dim MASA, KLS, MASAÜSTÜ As String
Dim SY As Long, S1 As Worksheet
Set MASA = CreateObject("Wscript.Shell")
Set KLS = CreateObject("Scripting.FileSystemObject")
Set S1 = Sheets("Bordro")
MASAÜSTÜ = MASA.SpecialFolders.Item("Desktop")
KLS.createfolder MASAÜSTÜ & "\" & S1.Range("AA11").Text
For SY = 1 To 65
S1.Range("B5") = SY
S1.ExportAsFixedFormat xlTypePDF, MASAÜSTÜ & "\" & S1.Range("AA11").Text & "\" & S1.Range("AA14").Text & ".pdf"
Next
End Sub

 

[akmlyx]

@asi_kral hocam merhaba, öncelikle sorunum ile ilgilendiğiniz için çok teşekkür ederim. Makroyu çalıştırınca ekteki hatayı verdi, sorun çözülmedi.

 

[asi_kral]

Merhaba
Eki inceler misiniz?
Başka arkadaşlarda bakabilir mi sorun nerede tam anlamadım.

 

[akmlyx]

@asi_kral hocam harikasınız, çok TEŞEKKÜR EDERİM. Makro gayet güzel çalışıyor. Ellerinize sağlık.
Sadece 2 husus var müsaadenizle onu belirteyim.
1- İşlem bittiği zaman Bordro sayfasındaki B5 hücresi en son 65 sayısında kalıyor, makro bu hücreye en son 1 sayısını yazdırmasını ve
2- Makro bitince ekrana msgbox ile bittiğine dair bilgi vermesini istiyorum.
Teşekkür ederim.

 

[asi_kral]

Merhaba

Sub kayıtlar()
Dim MASA, KLS, MASAÜSTÜ As String
Dim SY As Long, S1 As Worksheet
Set MASA = CreateObject("Wscript.Shell")
Set KLS = CreateObject("Scripting.FileSystemObject")
Set S1 = Sheets("Bordro")
MASAÜSTÜ = MASA.SpecialFolders.Item("Desktop")
KLS.createfolder MASAÜSTÜ & "\" & S1.Range("AA11").Text
For SY = 1 To 65
S1.Range("B5") = SY
S1.ExportAsFixedFormat xlTypePDF, MASAÜSTÜ & "\" & S1.Range("AA11").Text & "\" & S1.Range("AA14").Text & ".pdf"
Next
S1.Range("B5") = 1
MsgBox "İşlem Tamamlandı", , "Sonuç"
End Sub

Bununla değiştirir misiniz.

 

[akmlyx]

@asi_kral hocam, makro harika olmuş, şuan sorunsuz çalışıyor. Elinize sağlık, çok çok TEŞEKKÜR EDERİM.