-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
İSTEDİĞİM İSİMDE YENİ KLASÖR OLUŞTURMA...
- Konbuyu başlatan comp_wolf
- Başlangıç tarihi
muygun
Özel Üye
- Katılım
- 6 Temmuz 2004
- Mesajlar
- 9,227
- Excel Vers. ve Dili
- Excel-2003 Türkçe
Merhaba;
A1 hücresine;
="c:\deneme\a\b\"&METNEÇEVİR(G6;"gg.aa.yyyy")&" "&METNEÇEVİR(G7;"ss.dd.nn")
Formülünü uygulayın
Sub klasör_aç()
Application.ScreenUpdating = False
On Error Resume Next
Dim strPath As String
Dim lCtr As Long
strPath = Cells(1, 1)
arrpath = Split(strPath, "\")
strPath = arrpath(LBound(arrpath)) & "\"
For lCtr = LBound(arrpath) + 1 To UBound(arrpath)
strPath = strPath & arrpath(lCtr) & "\"
If Dir(strPath, vbDirectory) = "" Then
MkDir strPath
End If
Next
Application.ScreenUpdating = True
MsgBox "Klasör açma işlemi BİTTİ.", vbInformation
End Sub
Üstteki Makroyu sayfanın kod bölümüne yada bir modüle yapıştırın ve bir butona bağlayarak çalıştırın.
Kodlar alıntıdır.
İyi çalışmalar.
A1 hücresine;
="c:\deneme\a\b\"&METNEÇEVİR(G6;"gg.aa.yyyy")&" "&METNEÇEVİR(G7;"ss.dd.nn")
Formülünü uygulayın
Sub klasör_aç()
Application.ScreenUpdating = False
On Error Resume Next
Dim strPath As String
Dim lCtr As Long
strPath = Cells(1, 1)
arrpath = Split(strPath, "\")
strPath = arrpath(LBound(arrpath)) & "\"
For lCtr = LBound(arrpath) + 1 To UBound(arrpath)
strPath = strPath & arrpath(lCtr) & "\"
If Dir(strPath, vbDirectory) = "" Then
MkDir strPath
End If
Next
Application.ScreenUpdating = True
MsgBox "Klasör açma işlemi BİTTİ.", vbInformation
End Sub
Üstteki Makroyu sayfanın kod bölümüne yada bir modüle yapıştırın ve bir butona bağlayarak çalıştırın.
Kodlar alıntıdır.
İyi çalışmalar.
KOD İÇİN TEŞEKKÜRLER, AMA BEN BU KODU ÇALIŞTIRAMADIM. DEN A1 HÜCRESİNE ÖRNEK ALİ VEYA AHMET YAZDIĞIM ZAMAN İSTEDİĞİM KONUMA C:\DENEME\PROGRAM\ İÇERİSİNE YENİ KLASÖR AÇIP, KLASÖRÜN İSMİNİ DE A1 HÜCRESİNDE YAZAN ALİ VEYA AHMET OLMASINI İSTİYORUM? ÇOK MU ŞEY İSTEDİM ACABA SİZDEN?
muygun
Özel Üye
- Katılım
- 6 Temmuz 2004
- Mesajlar
- 9,227
- Excel Vers. ve Dili
- Excel-2003 Türkçe
Merhaba; syn. comp_wolf ;
Öncelikle yazılarınızı küçük harf yazın.
Bu sitede yapılabilirliği olan her talep mutlaka cevap bulur. (Tabi sorunun çözümüne yönelik yeterli açıklama ve bilhassa örnek uygulama ile destekleniyorsa.)
Üstte yazdığınız G6 ve G7 hücresi son yazdığınızda kaybolmuş!!!
Ben son yazdığınızı baz alarak örnek oluşturdum.
İndirip deneyin.
İyi çalışmalar.
Link:
https://dosya.co/x5jbyc4qsx04/comp_wolf-klasör_oluştur.rar.html
Öncelikle yazılarınızı küçük harf yazın.
Bu sitede yapılabilirliği olan her talep mutlaka cevap bulur. (Tabi sorunun çözümüne yönelik yeterli açıklama ve bilhassa örnek uygulama ile destekleniyorsa.)
Üstte yazdığınız G6 ve G7 hücresi son yazdığınızda kaybolmuş!!!
Ben son yazdığınızı baz alarak örnek oluşturdum.
İndirip deneyin.
İyi çalışmalar.
Link:
https://dosya.co/x5jbyc4qsx04/comp_wolf-klasör_oluştur.rar.html
merhabalar sayın muygun ,
öncelikle büyük harf için özür dilerim, bizim kullandığımız program küçük harf ile yazdığımız zaman algılamıyor o yüzden devamlı büyük harf açık birazda iş telaşından dikkatimden kaçmış kusura bakmayın.
yapmış olduğunuz kod çalıştı ben uygulama hatası yapmışım çok teşekkür ederim yardımlarınız için.
ben asıl istediğimi size eksik anlattım sanırım benim yapmak istediğimi daha net açıklayayım.
öncelikle exel sayfam açılır açılmaz geçici bir klasöre kaydediyor otomatikman. Daha sonra ben formu dolduruyorum ve yeniden kaydetmek için kaydet butonuna tıkladığım zaman istediğim adrese aşağıdaki kod ile kaydediyor.
--------------------------------------------
Private Sub CommandButton2_Click()
'KAYDET BUTONU
ActiveSheet.Protect Password:="1453"
ActiveSheet.Range("G5").Select
' araç modeline sadece rakam yazmak için
On Error GoTo son
If Intersect(Target, [R7]) Is Nothing Then GoTo 10
Application.EnableEvents = False
' If Target.Value = "." Then GoTo Son
If IsNumeric(Target) = False Then
MsgBox "OTO !!! Lütfen ARAÇ MODEL YILI Girişini yapınız...", vbInformation, "UYARI !!!"
Target = ""
' Target.Offset(0, 0).Select
Else
GoTo 10
End If
son:
Application.EnableEvents = True
' araç modeline sadece rakam yazmak için
10:
' sayfa gizle
Sayfa2.Visible = False
'Sayfa2.Protect
' sayfa gizle
'plakalık boş işe uyarı veriyor
On Error Resume Next
Application.ScreenUpdating = False
If [R7].Value = "" Then
MsgBox "OTO !!! Lütfen Model Yılını Yazınız."
'model yılı boş işe uyarı veriyor
GoTo 20
Else
If [G6].Value = "" Then
MsgBox "OTO !!! Lütfen Bir Plaka Yazınız."
'plakalık boş işe uyarı veriyor
Else
Dim silinecek As String
silinecek = ActiveWorkbook.Name
'istediğim klasöre farklı kaydet
Dim dosyam As String
Dim Tarih As String
Tarih = Format(Now, " _DD-MMM-YYYY_hh.mm.ss")
With Sheets("HASAR")
dosyam = "\\10.0.0.10\ortakdata\HASARLI ARAÇ\İŞLEMİ DEVAM EDEN\" & .Range("E6").Value & Tarih & ".xlsm"
ActiveWorkbook.SaveAs Filename:=dosyam
End With
MsgBox "SERVİS Kayıt işlemi bitmiştir. İYİ ÇALIŞMALAR...", vbInformation, "Kaydet"
dosyam = vbNullString
'istediğim klasöre farklı kaydet
Kill "\\10.0.0.10\ortakdata\HASARLI ARAÇ\ARŞİV\" & silinecek & " "
'exelden çıkış
Application.Quit
'exelden çıkış
End If
20:
End If
Sayfa1.Activate
ActiveSheet.Protect Password:="1453"
Range("G5").Activate
End Sub
---------------------------------------------------
ben sizin vermiş olduğunuz kodu buraya nasıl uyarlayabilirim? işlemi devam eden klasörünün içine kaydet dediğim zaman yeni klasörü oraya açıp onun içine dosyamı kaydetmesini istiyorum ?
Ve ben bu şekilde kaydettiğim zaman daha sonra kaydettiğim dosyayı açıp üzerinde değişiklik yapıp üzerine kaydetmek için yine kaydet butonuna bastığım zaman hata veriyor farklı bir buton ile yeniden kaydetmem gerekiyor.
farklı konular oldu sanırım ama yardımcı olabilirseniz sevinirim.
iyi günler
öncelikle büyük harf için özür dilerim, bizim kullandığımız program küçük harf ile yazdığımız zaman algılamıyor o yüzden devamlı büyük harf açık birazda iş telaşından dikkatimden kaçmış kusura bakmayın.
yapmış olduğunuz kod çalıştı ben uygulama hatası yapmışım çok teşekkür ederim yardımlarınız için.
ben asıl istediğimi size eksik anlattım sanırım benim yapmak istediğimi daha net açıklayayım.
öncelikle exel sayfam açılır açılmaz geçici bir klasöre kaydediyor otomatikman. Daha sonra ben formu dolduruyorum ve yeniden kaydetmek için kaydet butonuna tıkladığım zaman istediğim adrese aşağıdaki kod ile kaydediyor.
--------------------------------------------
Private Sub CommandButton2_Click()
'KAYDET BUTONU
ActiveSheet.Protect Password:="1453"
ActiveSheet.Range("G5").Select
' araç modeline sadece rakam yazmak için
On Error GoTo son
If Intersect(Target, [R7]) Is Nothing Then GoTo 10
Application.EnableEvents = False
' If Target.Value = "." Then GoTo Son
If IsNumeric(Target) = False Then
MsgBox "OTO !!! Lütfen ARAÇ MODEL YILI Girişini yapınız...", vbInformation, "UYARI !!!"
Target = ""
' Target.Offset(0, 0).Select
Else
GoTo 10
End If
son:
Application.EnableEvents = True
' araç modeline sadece rakam yazmak için
10:
' sayfa gizle
Sayfa2.Visible = False
'Sayfa2.Protect
' sayfa gizle
'plakalık boş işe uyarı veriyor
On Error Resume Next
Application.ScreenUpdating = False
If [R7].Value = "" Then
MsgBox "OTO !!! Lütfen Model Yılını Yazınız."
'model yılı boş işe uyarı veriyor
GoTo 20
Else
If [G6].Value = "" Then
MsgBox "OTO !!! Lütfen Bir Plaka Yazınız."
'plakalık boş işe uyarı veriyor
Else
Dim silinecek As String
silinecek = ActiveWorkbook.Name
'istediğim klasöre farklı kaydet
Dim dosyam As String
Dim Tarih As String
Tarih = Format(Now, " _DD-MMM-YYYY_hh.mm.ss")
With Sheets("HASAR")
dosyam = "\\10.0.0.10\ortakdata\HASARLI ARAÇ\İŞLEMİ DEVAM EDEN\" & .Range("E6").Value & Tarih & ".xlsm"
ActiveWorkbook.SaveAs Filename:=dosyam
End With
MsgBox "SERVİS Kayıt işlemi bitmiştir. İYİ ÇALIŞMALAR...", vbInformation, "Kaydet"
dosyam = vbNullString
'istediğim klasöre farklı kaydet
Kill "\\10.0.0.10\ortakdata\HASARLI ARAÇ\ARŞİV\" & silinecek & " "
'exelden çıkış
Application.Quit
'exelden çıkış
End If
20:
End If
Sayfa1.Activate
ActiveSheet.Protect Password:="1453"
Range("G5").Activate
End Sub
---------------------------------------------------
ben sizin vermiş olduğunuz kodu buraya nasıl uyarlayabilirim? işlemi devam eden klasörünün içine kaydet dediğim zaman yeni klasörü oraya açıp onun içine dosyamı kaydetmesini istiyorum ?
Ve ben bu şekilde kaydettiğim zaman daha sonra kaydettiğim dosyayı açıp üzerinde değişiklik yapıp üzerine kaydetmek için yine kaydet butonuna bastığım zaman hata veriyor farklı bir buton ile yeniden kaydetmem gerekiyor.
farklı konular oldu sanırım ama yardımcı olabilirseniz sevinirim.
iyi günler
Son düzenleme:
muygun
Özel Üye
- Katılım
- 6 Temmuz 2004
- Mesajlar
- 9,227
- Excel Vers. ve Dili
- Excel-2003 Türkçe
Olabilir.
sonuç alamazsanız örnek dosya ekleyin.
dosyanızı;
https://dosya.co/
adresine yükleyerek linkini buradan paylaşabilirsiniz.
sonuç alamazsanız örnek dosya ekleyin.
dosyanızı;
https://dosya.co/
adresine yükleyerek linkini buradan paylaşabilirsiniz.
https://dosya.co/voev9oafyzrr/comp_wolf_-GÖNDERİLEN.xlsm.html
üstat dosyayı yükledim, linki yukarıda. msj olarak mail adresimide atıyorum size. ben denedim yapamadım istediğim yere klasör oluşturuyorum ama o yeni oluşturduğum klasörün içerisine mevcut exel dosyamı kaydedemedim. yardımcı olursanız çok sevinirim iyi günler...
üstat dosyayı yükledim, linki yukarıda. msj olarak mail adresimide atıyorum size. ben denedim yapamadım istediğim yere klasör oluşturuyorum ama o yeni oluşturduğum klasörün içerisine mevcut exel dosyamı kaydedemedim. yardımcı olursanız çok sevinirim iyi günler...