Klasör içinde mükerrer dosya

A

acolkesen1

Katılım
5 Aralık 2007
Mesajlar
635
Excel Vers. ve Dili
Office 2007
Altın Üyelik Bitiş Tarihi
08-05-2021
Merhabalar,
Aşağıda yazılı kodlarla bir excel dosyasını D içerisinedeki "yedek" klasörüne Sayfa1!a1 de yazılı isimle kaydediyorum.Ancak aynı isimde bir başka dosya varsa uyarı verecek kodları bir türlü yapamadım.Çalışma kitabı içinde mükerrer sayfa adı olması durumunda çalışan kodları uyarlamaya çalıştım ama olmadı. Yardımcı olabilirmisiniz? İlgilenen arkadaşlara teşekkür ederim.

Sub Kayıt()
??????
ActiveWorkbook.SaveAs "D:\yedek\" & [Sayfa1!a1]
End Sub
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Aşağıdaki gibi kodunuzu değiştiriniz.

Kod: 
Sub Kayıt()
If Dir("D:\yedek\" & [Sayfa1!a1]) = "" Then
   MsgBox "Aynı isimli dosya var"
Else
   ActiveWorkbook.SaveAs "D:\yedek\" & [Sayfa1!a1]
End If
End Sub
 
A

acolkesen1

Katılım
5 Aralık 2007
Mesajlar
635
Excel Vers. ve Dili
Office 2007
Altın Üyelik Bitiş Tarihi
08-05-2021
Değerli Ferhat bey, daha önce de yardımlarınızı esirgememiştiniz. İlginizden dolayı çok teşekkür ederim.Sağlıcakla kalın.
 
A

acolkesen1

Katılım
5 Aralık 2007
Mesajlar
635
Excel Vers. ve Dili
Office 2007
Altın Üyelik Bitiş Tarihi
08-05-2021
Sayın Ferhat bey, yazdığınız kodları olması gereken yerlere yerleştirdim ama aynı dosya olmasa da uyarı mesajı veriyor. Acaba gözden kaçırdığım bir şey mi var.? Ben fazla oyalamamak için yardımlarınızla hazırladığım kodların bir bölümünü göndermiştim. Tamamı üzerinde daha sağlıklı olacak galiba. kodlar aşağıdaki gibi:
Sub devir()
ActiveSheet.Unprotect
Range("B4").Select
Selection.Locked = True
Selection.FormulaHidden = False
Range("B10").Select
Selection.Locked = True
Selection.FormulaHidden = False
If MsgBox("BİLGİLER KAYDEDİLİP PROGRAM KAPATILACAK. DEVAM ETMEK İSTİYOR MUSUNUZ?", vbYesNo, "") = vbNo Then Exit Sub
For i = 1 To Worksheets.Count
If Range("B10").Value = "" Then
MsgBox "DEVİR YAPACAĞINIZ YILI YAZINIZ.."
Exit Sub
End If
Next i

If IsDate(Range("B4")) = False Then
MsgBox "DEVİR TARİHİNİ BELİRLEYİNİZ!", vbCritical, "UYARI"
Exit Sub
Else

End If
If Date < Range("B4") Then
MsgBox Range("B4") & " TAR&#304;H&#304;NDEN &#214;NCE DEV&#304;R YAPAMAZSINIZ", vbCritical, "UYARI"

Exit Sub
Else
M&#252;kerrer kay&#305;t uyar&#305;s&#305; verecek kodlar bu sat&#305;ra yaz&#305;lacak
MsgBox "BU &#304;S&#304;MDE B&#304;R DOSYA VAR, BA&#350;KA &#304;S&#304;MLE KAYIT YAPINIZ!", vbCritical, "UYARI"
Exit Sub
End If
Sheets("B&#304;LAN&#199;O").Select
Cells.Select
ActiveSheet.Unprotect
Cells.Select
Selection.Copy
Sheets("DEV&#304;R").Select
Cells.Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
Sheets("BEKLEY&#304;N&#304;Z").Select

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "D:\APARTMAN\" & ([KURULUMSAYFASI!a10] & [KURULUMSAYFASI!b10])
Application.Quit
End Sub
 
Son düzenleme:
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Aşağıdaki gibi deneyiniz.

Kod: 
Sub devir()
....[/COLOR]
[COLOR=dimgray]....[/COLOR]
[COLOR=dimgray]....[/COLOR]
[COLOR=silver][COLOR=dimgray]If Date < Range("B4") Then
   MsgBox Range("B4") & " TARİHİNDEN ÖNCE DEVİR YAPAMAZSINIZ", vbCritical, "UYARI"
   Exit Sub
Else[/COLOR]
[/COLOR][COLOR=seagreen][B]   'Mükerrer kayıt uyarısı verecek kodlar bu satıra yazılacak
[/B][/COLOR][COLOR=red]   If Dir("D:\yedek\" & [Sayfa1!a1]) = "" Then
      MsgBox "BU İSİMDE BİR DOSYA VAR, BAŞKA İSİMLE KAYIT YAPINIZ!", vbCritical, "UYARI"
      Exit Sub
   Else
      ActiveWorkbook.SaveAs "D:\yedek\" & [Sayfa1!a1]
   End If
[/COLOR][COLOR=dimgray]End If
Sheets("BİLANÇO").Select
Cells.Select
[/COLOR]...
...
...
End Sub
 
A

acolkesen1

Katılım
5 Aralık 2007
Mesajlar
635
Excel Vers. ve Dili
Office 2007
Altın Üyelik Bitiş Tarihi
08-05-2021
Say&#305;n Pazar&#231;evirdi, yard&#305;mlar&#305;n&#305;z i&#231;in te&#351;ekk&#252;r ederim ama olmad&#305; yine.
Makrodan k&#305;rm&#305;z&#305; olan k&#305;sm&#305; &#231;&#305;kar&#305;nca aky&#305;t yap&#305;yor,(eskisinin &#252;zerine tabii) aksi halde kay&#305;t yap&#305;lan klas&#246;r i&#231;inde ayn&#305; isimde bir dosya olamad&#305;&#287;&#305; halde uyar&#305; veriyor. Nerde hata yap&#305;yorum &#231;&#246;zemedim..Makronun son hali a&#351;a&#287;&#305;daki gibidir.

Sub devir()
'
' devir Makro
'
'

'

ActiveSheet.Unprotect
Range("B4").Select
Selection.Locked = True
Selection.FormulaHidden = False
Range("B10").Select
Selection.Locked = True
Selection.FormulaHidden = False
If MsgBox("B&#304;LG&#304;LER KAYDED&#304;L&#304;P PROGRAM KAPATILACAK. DEVAM ETMEK &#304;ST&#304;YOR MUSUNUZ?", vbYesNo, "") = vbNo Then Exit Sub
For i = 1 To Worksheets.Count
If Range("B10").Value = "" Then
MsgBox "DEV&#304;R YAPACA&#286;INIZ YILI YAZINIZ.."
Exit Sub
End If
Next i

If IsDate(Range("B4")) = False Then
MsgBox "DEV&#304;R TAR&#304;H&#304;N&#304; BEL&#304;RLEY&#304;N&#304;Z!", vbCritical, "UYARI"
Exit Sub
Else

End If
If Date < Range("B4") Then
MsgBox Range("B4") & " TAR&#304;H&#304;NDEN &#214;NCE DEV&#304;R YAPAMAZSINIZ", vbCritical, "UYARI"
Exit Sub
Else

If Dir("D:\APARTMAN\" & ([KURULUMSAYFASI!a10] & [KURULUMSAYFASI!b10])) = "" Then
MsgBox "BU &#304;S&#304;MDE B&#304;R DOSYA VAR, BA&#350;KA &#304;S&#304;MLE DEV&#304;R YAPINIZ!", vbCritical, "UYARI"
Exit Sub
Else
End If
Sheets("B&#304;LAN&#199;O").Select
Cells.Select
Selection.Copy
Sheets("DEV&#304;R").Select
Cells.Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
Sheets("BEKLEY&#304;N&#304;Z").Select
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "D:\APARTMAN\" & ([KURULUMSAYFASI!a10] & [KURULUMSAYFASI!b10])
Application.Quit
End Sub
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
A&#351;a&#287;&#305;daki &#351;ekilde deneyin.Olacak.:cool:
Kod: 
If Dir("D:\APARTMAN\" & ([KURULUMSAYFASI!a10] & [KURULUMSAYFASI!b10])) [COLOR="Red"][B]<>[/B][/COLOR] "" Then
MsgBox "BU &#304;S&#304;MDE B&#304;R DOSYA VAR, BA&#350;KA &#304;S&#304;MLE DEV&#304;R YAPINIZ!", vbCritical, "UYARI"
Exit Sub
Else
 
E

ECYavuz

Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
If Dir("D:\APARTMAN\" & ([KURULUMSAYFASI!a10] & [KURULUMSAYFASI!b10])) <> "" Then
MsgBox "BU &#304;S&#304;MDE B&#304;R DOSYA VAR, BA&#350;KA &#304;S&#304;MLE DEV&#304;R YAPINIZ!", vbCritical, "UYARI"
Exit Sub
Else

B&#246;l&#252;m&#252;nde "=" k&#305;sm&#305;n&#305; "<>" olarak de&#287;i&#351;tirirmisiniz?
 
A

acolkesen1

Katılım
5 Aralık 2007
Mesajlar
635
Excel Vers. ve Dili
Office 2007
Altın Üyelik Bitiş Tarihi
08-05-2021
Sevgili Evren Gizlen ve ECYavuz , her ikinize de te&#351;ekk&#252;r ederim &#252;stadlar...Sizin i&#231;in k&#252;&#231;&#252;k ama benim i&#231;in &#246;nemli olan yard&#305;mlar&#305;n&#305;z i&#231;in....Ama daha da &#246;nemlisi her&#351;eyi sadece yard&#305;mc&#305; olmak ad&#305;na yap&#305;yor olman&#305;z.. &#304;yi ki vars&#305;n&#305;z..
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
acolkesen1' Alıntı:
Sevgili Evren Gizlen ve ECYavuz , her ikinize de teşekkür ederim üstadlar...Sizin için küçük ama benim için önemli olan yardımlarınız için....Ama daha da önemlisi herşeyi sadece yardımcı olmak adına yapıyor olmanız.. İyi ki varsınız..
Genişletmek için tıkla ...
Rica ederim.
iiyi çalışmalar.:cool:
 
A

acolkesen1

Katılım
5 Aralık 2007
Mesajlar
635
Excel Vers. ve Dili
Office 2007
Altın Üyelik Bitiş Tarihi
08-05-2021
De&#287;erli Arkada&#351;lar, yukar&#305;daki kodlarldaki son d&#252;zeltmeden sonra dosya kaydedilmeye ba&#351;lad&#305; ama bu sefer de klas&#246;r i&#231;inde ayn&#305; isimde dosya olmas&#305;na ra&#287;men &#252;zerine kaydediyor. Daha &#246;nceki sorun m&#252;kerrer dosya olamamas&#305;na ra&#287;men m&#252;kerrer uyar&#305;s&#305; veriyor ve kaydetmiyordu. Kay&#305;t yapmaya ba&#351;lay&#305;nca sorun &#231;&#246;z&#252;ld&#252; sanm&#305;&#351;t&#305;m.Fark&#305;nda olmadan bir de&#287;i&#351;iklik mi yapt&#305;m bilemiyorum.. Kodlara bir kere daha bakabilirmisiniz acaba?

Sub devir()
'
'
'
'

'

ActiveSheet.Unprotect
Range("B4").Select
Selection.Locked = True
Selection.FormulaHidden = False
Range("B10").Select
Selection.Locked = True
Selection.FormulaHidden = False
If MsgBox("B&#304;LG&#304;LER KAYDED&#304;L&#304;P PROGRAM KAPATILACAK. DEVAM ETMEK &#304;ST&#304;YOR MUSUNUZ?", vbYesNo, "") = vbNo Then Exit Sub
For i = 1 To Worksheets.Count
If Range("B10").Value = "" Then
MsgBox "DEV&#304;R YAPACA&#286;INIZ YILI YAZINIZ.."
Exit Sub
End If
Next i

If IsDate(Range("B4")) = False Then
MsgBox "DEV&#304;R TAR&#304;H&#304;N&#304; BEL&#304;RLEY&#304;N&#304;Z!", vbCritical, "UYARI"
Exit Sub
Else

End If
If Date < Range("B4") Then
MsgBox Range("B4") & " TAR&#304;H&#304;NDEN &#214;NCE DEV&#304;R YAPAMAZSINIZ", vbCritical, "UYARI"
Exit Sub
Else

If Dir("D:\APARTMAN\" & ([KURULUMSAYFASI!a10] & [KURULUMSAYFASI!b10])) <> "" Then
MsgBox "BU &#304;S&#304;MDE B&#304;R DOSYA VAR, BA&#350;KA &#304;S&#304;MLE DEV&#304;R YAPINIZ!", vbCritical, "UYARI"
Exit Sub
Else

End If
Sheets("B&#304;LAN&#199;O").Select
Cells.Select
Selection.Copy
Sheets("DEV&#304;R").Select
Cells.Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
Sheets("BEKLEY&#304;N&#304;Z").Select

ActiveWorkbook.SaveAs "D:\APARTMAN\" & ([KURULUMSAYFASI!a10] & [KURULUMSAYFASI!b10])
End If
Application.Quit
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst