command button ile klasör oluşturma

U

ustguv

Katılım
23 Mayıs 2022
Mesajlar
2
Excel Vers. ve Dili
2003
Merhaba sayın uzmanlar, sorunum şudur. değerli yardım veya fikirlerinizi bekliyorum. Yardımcı olursanız sevinirim.

command button içinde aşağıda belirttiğim gibi şuan sadece yazdırma komutu var. Buna ek olarak yapmak istediğim ise şudur:
Düğmeye tıkladığımda B5 hücresindeki değere göre masaüstüne klasör oluşturmak ve D:\Fotoğraflar klasöründeki aynı isimli fotoğrafı, oluşturduğu yeni klasöre kopyalamaktır.

Private Sub CommandButton1_Click()
If IsEmpty(Sheets("Kayıtlı").Range("B2")) Then MsgBox "Başvuru Türü Giriniz": Exit Sub
If IsEmpty(Sheets("Kayıtlı").Range("B3")) Then MsgBox "Sertifika Türü Giriniz": Exit Sub
If IsEmpty(Sheets("Kayıtlı").Range("B4")) Then MsgBox "Kan Grubu Giriniz": Exit Sub
If IsEmpty(Sheets("Kayıtlı").Range("B5")) Then MsgBox "T.C No Giriniz": Exit Sub
Sheets("kayıtlı").PrintOut
Range("B2,b3,b4,b5").ClearContents
ActiveWorkbook.Save
End Sub
 
U

ustguv

Katılım
23 Mayıs 2022
Mesajlar
2
Excel Vers. ve Dili
2003
teşekkür ederim. masaüstüne klasör oluşturma kısmını çözdüm fakat oluşturduğum dosyaya aynı isimdeki fotoğrafı kopyalama kısmında takılıyorum. kodların son hali şu şekilde oldu. B5 hücresindeki değer isminde klasör oluşturuyor. ancak "D:/Fotoğraf" klasöründen aynı isimdeki fotoyu bulup oluşturduğu klasöre nasıl kopyalayacağımı bilemedim

Private Sub CommandButton1_Click()

Dim Klasor As String, Ayrac As String

Ayrac = Application.PathSeparator
Klasor = Environ("UserProfile") & Ayrac & "desktop" & Ayrac & Range("B5")

If Dir(Klasor, vbDirectory) <> "" Then
MsgBox "Klasör mevcut !", vbExclamation
Else
MkDir (Klasor)
MsgBox "Klasör oluşturulmuştur.", vbInformation
End If

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst