HÜCREDE YAZAN İSİMLERDE KLASÖR VE DOSYA OLUŞTURMA

[imdatsaral]

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

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.