Exit Sub'dan sonra userformun çalışmasını istiyorum.

[s.savas]

Merhaba arkadaşlar.

Aşağıdaki kodu, zaman kontrolü yaparak günün tarihi 31 Aralık değilse "31 Aralık'tan Önce Yeni Dönem Oluşturamazsınız." mesajından sonra Userform1 tekrar aktif olsun, günün tarihi 31 Aralık ise yeni dönem açıldıktan sonra Userform1 tekrar aktif olacak şekilde düzenleyemedim.

Private Sub Image1_Click()
UserForm1.Hide

Dim saat1 As Date
Dim saat2 As Date
Dim su
saat1 = DateSerial(Year(Date), 12, 31)
saat2 = Date
If saat2 < saat1 Then
su = MsgBox("31 Aralık'tan  Önce Yeni Dönem Oluşturamazsınız.", vbInformation + vbOKOnly _
, "SÜRE BİLDİRİMİ * S.S *")
Exit Sub

ElseIf saat1 = saat2 Then
If MsgBox("Stok devri yapılarak yeni dönem açılacak. Programla ilgili sorunlarınız için e-posta gönderiniz veya arayıınız!" & vbLf & vbLf & "e-posta: s_savas_@hotmail.com, Tel: 0506 123 45 67", vbInformation + vbYesNo _
, "..::DİKKAT::.. * Süleyman Savaş *") = vbNo Then Exit Sub
End If

Set s1 = Sheets("Aralık")
Set s2 = Sheets("Ocak")
s2.Range("B6:D65536").ClearContents
        
son = s1.Cells(Rows.Count, "C").End(xlUp).Row
s1.Range("B6:D" & son).Copy
s2.[B6].PasteSpecial
               
son = s1.Cells(Rows.Count, "AP").End(xlUp).Row
s1.Range("AO6:AO" & son).Copy
s2.[E6].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
       
Application.CutCopyMode = 0
Set s1 = Nothing
Set s2 = Nothing

Dim sht As Worksheet
Dim dizi() As Variant
Dim eleman As String

dizi = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", _
"Eylül", "Ekim", "Kasım", "Aralık")

For Each sht In Worksheets
eleman = sht.Name
If InStr(Join(dizi), eleman) > 0 Then
sht.Range("F6:AM65536").ClearContents
End If
Next
MsgBox "Bütün Stok Verileri Silindi. Yeni Döneme ait ismini yazınız."
   
Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.Save 
End Sub

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Private Sub Image1_Click()
UserForm1.Hide

Dim saat1 As Date
Dim saat2 As Date
Dim su
saat1 = DateSerial(Year(Date), 12, 31)
saat2 = Date
If saat2 < saat1 Then
su = MsgBox("31 Aralık'tan  Önce Yeni Dönem Oluşturamazsınız.", vbInformation + vbOKOnly _
, "SÜRE BİLDİRİMİ * S.S *")
[COLOR=red]UserForm1.Show[/COLOR]
Exit Sub

ElseIf saat1 = saat2 Then
If MsgBox("Stok devri yapılarak yeni dönem açılacak. Programla ilgili sorunlarınız için e-posta gönderiniz veya arayıınız!" & vbLf & vbLf & "e-posta: s_savas_@hotmail.com, Tel: 0506 123 45 67", vbInformation + vbYesNo _
, "..::DİKKAT::.. * Süleyman Savaş *") = vbNo Then Exit Sub
End If

Set s1 = Sheets("Aralık")
Set s2 = Sheets("Ocak")
s2.Range("B6:D65536").ClearContents
        
son = s1.Cells(Rows.Count, "C").End(xlUp).Row
s1.Range("B6:D" & son).Copy
s2.[B6].PasteSpecial
               
son = s1.Cells(Rows.Count, "AP").End(xlUp).Row
s1.Range("AO6:AO" & son).Copy
s2.[E6].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
       
Application.CutCopyMode = 0
Set s1 = Nothing
Set s2 = Nothing

Dim sht As Worksheet
Dim dizi() As Variant
Dim eleman As String

dizi = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", _
"Eylül", "Ekim", "Kasım", "Aralık")

For Each sht In Worksheets
eleman = sht.Name
If InStr(Join(dizi), eleman) > 0 Then
sht.Range("F6:AM65536").ClearContents
End If
Next
MsgBox "Bütün Stok Verileri Silindi. Yeni Döneme ait ismini yazınız."
   
Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.Save 
[COLOR=red]UserForm1.Show[/COLOR]
End Sub

 

[s.savas]

Çok teşekkür ederim üstat.Sorun çözüldü.