Eğer Değişken hücreler boşsa uyarı versin

[mehmetkoca]

Değerli Üstadlar ;
Ekteki dosyamda yedekal makrosuna göre eğer 3 değişken hücreden herhangi biri (c2 , c3 ve c4 hücrelerinden biri ) boşsa işlemi kabul etmemesini istiyorum.Eğer zaten hücreler doluysa yedekleme yapıyor (daha önce yedeklenmemişse).

Saygılarımla..

Sub yedekkal()
deg1 = "C:\Documents and Settings\xp\Desktop\mobilya"
deg2 = Cells(2, "C").Value
deg3 = Cells(3, "C").Value
deg4 = Cells(4, "C").Value
On Error Resume Next
If Dir(deg1) = "" Then MkDir (deg1)
If Dir(deg1 & "\" & deg2) = "" Then MkDir (deg1 & "\" & deg2)
If Dir(deg1 & "\" & deg2 & "\" & deg3) = "" Then MkDir (deg1 & "\" & deg2 & "\" & deg3)
Sayfa_adı = ActiveSheet.Name 'sayfa adını buraya yazınız.
kayıt_yeri = deg1 & "\" & deg2 & "\" & deg3 & "\" & deg3 & "-" & deg4 & "-" & "ARKALIK" & ".xls" 'Kayıt yapılacak yer
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(kayıt_yeri)
If a = True Then
MsgBox "DİKKAT!!!BU SİPARİŞ DAHA ÖNCE YEDEKLENMİŞTİR!", vbCritical, "Dikkat !"
Else
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_adı Then
sayfa.Copy
Sheets(ActiveSheet.Name).Name = Sayfa_adı
ActiveSheet.DrawingObjects.Delete
ActiveWorkbook.SaveAs kayıt_yeri
ActiveWorkbook.Close False
MsgBox "YEDEKLEME TAMAMLANMIŞTIR", vbInformation, "Bilgi"
Exit Sub
End If
Next sayfa
End If
End Sub

 

[İhsan Tank]

Değerli Üstadlar ;
Ekteki dosyamda yedekal makrosuna göre eğer 3 değişken hücreden herhangi biri (c2 , c3 ve c4 hücrelerinden biri ) boşsa işlemi kabul etmemesini istiyorum.Eğer zaten hücreler doluysa yedekleme yapıyor (daha önce yedeklenmemişse).

Saygılarımla..

Sub yedekkal()
deg1 = "C:\Documents and Settings\xp\Desktop\mobilya"
deg2 = Cells(2, "C").Value
deg3 = Cells(3, "C").Value
deg4 = Cells(4, "C").Value
On Error Resume Next
If Dir(deg1) = "" Then MkDir (deg1)
If Dir(deg1 & "\" & deg2) = "" Then MkDir (deg1 & "\" & deg2)
If Dir(deg1 & "\" & deg2 & "\" & deg3) = "" Then MkDir (deg1 & "\" & deg2 & "\" & deg3)
Sayfa_adı = ActiveSheet.Name 'sayfa adını buraya yazınız.
kayıt_yeri = deg1 & "\" & deg2 & "\" & deg3 & "\" & deg3 & "-" & deg4 & "-" & "ARKALIK" & ".xls" 'Kayıt yapılacak yer
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(kayıt_yeri)
If a = True Then
MsgBox "DİKKAT!!!BU SİPARİŞ DAHA ÖNCE YEDEKLENMİŞTİR!", vbCritical, "Dikkat !"
Else
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_adı Then
sayfa.Copy
Sheets(ActiveSheet.Name).Name = Sayfa_adı
ActiveSheet.DrawingObjects.Delete
ActiveWorkbook.SaveAs kayıt_yeri
ActiveWorkbook.Close False
MsgBox "YEDEKLEME TAMAMLANMIŞTIR", vbInformation, "Bilgi"
Exit Sub
End If
Next sayfa
End If
End Sub

merhaba
kod'u bununla değiştiriniz

Sub yedekkal()
deg1 = "C:\Documents and Settings\xp\Desktop\mobilya"
deg2 = Cells(2, "C").Value
deg3 = Cells(3, "C").Value
deg4 = Cells(4, "C").Value
For ts = 2 To 4
If Cells(ts, "C") = "" Then
MsgBox "C" & ts & " Boş"
Exit Sub
End If
Next
On Error Resume Next
If Dir(deg1) = "" Then MkDir (deg1)
If Dir(deg1 & "\" & deg2) = "" Then MkDir (deg1 & "\" & deg2)
If Dir(deg1 & "\" & deg2 & "\" & deg3) = "" Then MkDir (deg1 & "\" & deg2 & "\" & deg3)
Sayfa_adı = ActiveSheet.Name 'sayfa adını buraya yazınız.
kayıt_yeri = deg1 & "\" & deg2 & "\" & deg3 & "\" & deg3 & "-" & deg4 & "-" & "ARKALIK" & ".xls" 'Kayıt yapılacak yer
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(kayıt_yeri)
If a = True Then
MsgBox "DİKKAT!!!BU SİPARİŞ DAHA ÖNCE YEDEKLENMİŞTİR!", vbCritical, "Dikkat !"
Else
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_adı Then
sayfa.Copy
Sheets(ActiveSheet.Name).Name = Sayfa_adı
ActiveSheet.DrawingObjects.Delete
ActiveWorkbook.SaveAs kayıt_yeri
ActiveWorkbook.Close False
MsgBox "YEDEKLEME TAMAMLANMIŞTIR", vbInformation, "Bilgi"
Exit Sub
End If
Next sayfa
End If
End Sub

 

[mehmetkoca]

teşekkürler

Teşekkür ederim İhsan Hocam.Biraz geç oldu özür dilerim.Emeğinize yüreğinize sağlık.Saygılarımla.

 

[İhsan Tank]

Teşekkür ederim İhsan Hocam.Biraz geç oldu özür dilerim.Emeğinize yüreğinize sağlık.Saygılarımla.

rica ederim
:yazici: