İşi sonlandırma komutu

[Sa.NaL]

Merhaba benim excel uzmanı arkadaşlardan ricam.Ben aşağıdaki gibi bir işlem yapmak istiyorum ama açıklama ile belirttiğim yerlere nasıl kodlar gelir bilmiyorum yardımcı olursanız sevinirim iyi çalışmalar.

Private Sub CommandButton1_Click()
Dim cevap
cevap = InputBox("Sonlandırılması istenen iş emir numarasını giriniz...: ", "İŞİ SONLANDIRMA", "")
if cevap=
'c:/ deneme dosyasının içinde varsa inputboxa verilen cevap.xls excel dosyası onun içindeki E1 hücresine'
'günün tarihini eşitle ve o klasörün içinden dosyayı kesip d:/yapılan işler klasörüne at..'
Else
MsgBox ("Böyle bir işemir numarası bulunmamaktadır...")
End If
End Sub

 

[Sa.NaL]

Uzman arkadaşlar yardımcı olabilirmisiniz?

 

[ozgretmen]

c:/ deneme dosyasının içinde varsa inputboxa verilen cevap.xls excel dosyası onun içindeki E1 hücresine'
'günün tarihini eşitle ve o klasörün içinden dosyayı kesip d:/yapılan işler klasörüne at..'

Burayı biraz açar mısın ?
C deki dosya nasıl bir şey ekler misin ?

 

[Sa.NaL]

C nin içindeki bir excel dosyası örneğin SN33-09-01-001.xls diye bir excel dosyası inputboxa o numarayı yazınca deneme içinde öyle bir excel dosyası varsa onun içindeki 1sayfada E1 hücresine günün tarihini eşitlesin ve o excel dosyasını oradan kesip d ye yapılan işler klasörünün içine atsın inputboxa girilen iş emir numarası yoksa deneme klasörünün içinde böyle bir iş emir numarası bulunmamaktadır diye uyarı versin

 

[Sa.NaL]

Yani iş bitirirken atölyede o günün tarihini verip hesap kesiyoruz o iş emir numarasına klasör normalde ağa bağlı bir bilgisayarda onun içinden alıp ben o excel dosyasını ana makinadaki yapılan işler klasörüne alıyorum ben yukarıdakileri faraza olarak yzıyorum adresleri değiştiricem hocam inş olur ya bu işimi çok kolaylaştıracak.

 

[ozgretmen]

Yani iş bitirirken atölyede o günün tarihini verip hesap kesiyoruz o iş emir numarasına klasör normalde ağa bağlı bir bilgisayarda onun içinden alıp ben o excel dosyasını ana makinadaki yapılan işler klasörüne alıyorum ben yukarıdakileri faraza olarak yzıyorum adresleri değiştiricem hocam inş olur ya bu işimi çok kolaylaştıracak.

C de deneme ve D de İşler isimli iki klasör oluşturun.Bu kitabın adını değiştirmeyin.İnputbox a girmiş olduğunuz kodla ilgili kitabı C deneme içinde arar eğer varsa alır D de İşler kalsörüne atar ve C deki siler.Bir inceleyiniz..

 

[Sa.NaL]

Hocam böyle bir uyarı veriyor:
Gizlilik uyarısı:Bu belge makrolar,Activex denetimleri,XML genişleme paketi bilgileri ve web bileşenleri içeriyor.Bunlar belge denetçisi tarafından kaldıralamayan bilgiler olabilir.

 

[Sa.NaL]

Hocam bilmişşlik taslamaktan değil copyala yapıştır sil işlemlerii yerine sadece kesme komutu varmı acaba?

 

[ozgretmen]

Hocam böyle bir uyarı veriyor:
Gizlilik uyarısı:Bu belge makrolar,Activex denetimleri,XML genişleme paketi bilgileri ve web bileşenleri içeriyor.Bunlar belge denetçisi tarafından kaldıralamayan bilgiler olabilir.

Ne yalan söyliyim...Bende de aynı uyarıyı veriyor.Ama dosya çalışıyor , işini gör dü mü ?

 

[Sa.NaL]

hocam teşekkür ederim listele fonksiyonunu hiç anlamadım biraz anlatabilirmisiniz birde neden A1 hücresinden sonuna kadar satırların neden for döngüsü kurdunuz?

 

[ozgretmen]

hocam teşekkür ederim listele fonksiyonunu hiç anlamadım biraz anlatabilirmisiniz birde neden A1 hücresinden sonuna kadar satırların neden for döngüsü kurdunuz?

Modüle 1 de listele ya ait kodlarvar.Bu kodlar ile C:deneme klasörü içindeki dosyaların adlarını a1 den başlayarak alt alta yazdırıyoruz.Burada A1 den A daki son dolu satıra kadar döngü kurup , inputbox la gelen değeri karşılaştırma yapıyoruz.Eğer uygun sonuç varsa işlem devam ediyor.

Birde dosyadaki Userformdaki commandButton a ait kodları aşağıdaki ile değiştiriniz.Bununla kopyala,yapıştır ,sil yapmadan direk dosyayı C den kesip D ye aktarıyor.

Private Sub CommandButton1_Click()
On Error Resume Next
Dim ds, f
Set ds = CreateObject("Scripting.FileSystemObject")
Listele
Dim cevap
cevap = InputBox("Sonlandırılması istenen iş emir numarasını giriniz...: ", "İŞİ SONLANDIRMA", "")
For i = 1 To [A65536].End(3).Row
If cevap = Cells(i, "A") Then
Workbooks.Open Filename:="C:\deneme\" & cevap & ".xls"
Range("E1").Value = Date
ActiveWorkbook.Save
Windows("Ek").Activate
Windows(cevap & ".xls").Close
f = ds.MoveFile("C:\Deneme\" & cevap & ".xls", "D:\İşler\" & cevap & ".xls")
Exit Sub
Else
MsgBox "Böyle bir işemir numarası bulunmamaktadır..."
End If
Next i
End Sub

 

[Sa.NaL]

Çok teşekkür ederim hocam vaktininz varsa şurayı satır satır ne yaptığını anlatabilirmisiniz
Sub Listele()
Range("A1:A500").Clear
Range("A1").Select
Dim FSO As Object, f As Object
Set FSO = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).SubFolders
D = Dir("C:/Deneme" & "/")
If D <> "" Then
While Not D = ""
i = i + 1
Cells(i, "A") = Split(D, ".")
D = Dir
Wend
End If
Set FSO = Nothing
End Sub

Ve bu nedemek Set ds = CreateObject("Scripting.FileSystemObject") yardımlarınızı bekliyorum

 

[Sa.NaL]

Hocam birde hata teşhis ettim mesela deneme içinde 10 tane excel dosyası var ben onların içinde olmayan isimi yazınca ınputboxa 11 kere böyle bir işemri bulunmamaktadır çıkıyor

 

[Sa.NaL]

acaba ınputboxla yaptık diyemiki textbox ekleyip yapsak birde deneme içinde olanları listbox1 e listelense yapılan işler listbox2 olsa oraya bir sağtarafı gösteren ok işareti ile komut butonu oluşturup ona tıkladıkmı deneme listbox1 deki seçili olan listelenmiş excel dosya isimlerini yapılan işler listbox2 ye aktarsa hocam valla böyle birşey yapmada yardımcı olursanız çok sevinirim

 

[Sa.NaL]

Ve bu isteğim de sizden son biliyorum çok vaktinizi çaldım ama süer bir proje yapmaya atıldım bir yandan da ööğrenmeye çalışıyorum ama farkındayım bazen bilmediğim işlere sarkıyorum sizin yardımınızla kurtulurum inş

 

[ozgretmen]

Çok teşekkür ederim hocam vaktininz varsa şurayı satır satır ne yaptığını anlatabilirmisiniz
Ve bu nedemek Set ds = CreateObject("Scripting.FileSystemObject") yardımlarınızı bekliyorum

Dosya içinde anlatmaya çalıştım...

 

[Sa.NaL]

Hocam mesajlarım önce kaldığı için unutmazsınız umarım

 

[Sa.NaL]

Hocam ben böyle birşey denedim oldu ama listbox2yi dir komutu nasıl uygulanır onu halledemedim
Private Sub CommandButton1_Click()
For i = 1 To [A65536].End(3).Row
ListBox1.AddItem Cells(i, "A")
Next i
On Error Resume Next
Dim ds, f
Set ds = CreateObject("Scripting.FileSystemObject")
Listele
Dim cevap
cevap = InputBox("Sonlandırılması istenen iş emir numarasını giriniz...: ", "İŞİ SONLANDIRMA", "")
For i = 1 To [A65536].End(3).Row
If cevap = Cells(i, "A") Then
Workbooks.Open Filename:="C:\deneme\" & cevap & ".xls"
Range("E1").Value = Date
ActiveWorkbook.Save
Windows("Ek").Activate
Windows(cevap & ".xls").Close
f = ds.MoveFile("C:\Deneme\" & cevap & ".xls", "D:\İşler\" & cevap & ".xls")
Exit Sub
End If
Next i
If cevap = "" And cevap <> ListBox1.List Then
MsgBox "Böyle Bir İşemir Numarası Bulunmamaktadır...!"
End If
End Sub