HÜCREDE YAZAN ÝSÝMLERDE KLASÖR VE DOSYA OLUÞTURMA

[imdatsaral]

SELAM ARKADAÞLAR

EKTEKÝ EXCEL SAYFASINI ÝNCELERMÝSÝNÝZ.

[xxrt]

Ýmdatsaralýn sorusu þöyle:
1.Soru:B1 Hücersinde Yazýlý olan Firma adý=SKOGEN
Bu ad ile Klasör açýlsýn..
2.Soru:B2 Hücresinde Yazýlý olan Model Adý=A550-5
Bu Ad Ýlede Dosya oluþturulsun.

1.Cevap:B1 SKOGEN adýna Klasör oluþturuyoruz.
Sub Dosya()
Sheets(1).Select
Sheets(1).Name = [B2]
Dim MyFolder As String
MyFolder = "C:\" & [B1] & ""
MkDir MyFolder
End Sub

2.Cevap:B1 Hücresindeki Firma adý ve B2 Hücresinde Yazýlý olan A550-5 Model ile dosyayý kaydedelim..
Sub Dosya()
Sheets(1).Select
Sheets(1).Name = [b2]
Dim MyFolder As String
MyFolder = "C:\" & Range("B1") & ""
MkDir MyFolder
ActiveWorkbook.SaveAs "C:\" & [b1] & "Firmasý " & [b2] & "Model " & ".XLS"
End Sub

Birbaþka Kod ilede Bunu Yapabiliriz..
Sub create()
On Error GoTo Error
drive$ = InputBox("Sürücü adýný giriniz", "Sürücü ?")
drive$ = drive$ & ":\"
Path$ = InputBox("Hangi klasör altýnda oluþturmak istiyorsunuz.Sizin Açacaðýnýz Klasör Adý : " & [b1], "Yol ?")
If Path$ <> "" Then Path$ = Path$ & "\"
MyPath$ = Range("b1").Value
Final$ = drive$ & Path$ & MyPath$
MkDir (Final$)
Exit Sub
Error:
MsgBox "VB Hata No = " & Err.Number & vbCrLf & vbCrLf & "Açýklama :" & vbCrLf & Err.Description, vbApplicationModal, "HATA !!!"
End Sub

Sizin istediðiniz tam olarak c:\SKOGEN\A550-5.xls idi fakat þu an gece 00:09 bu nedenle yarýn bir ara fýrsatým olursa bakarým..Kolay gelsin.