Hücre eşitsizliği varsa makroyu durdur

[imyourfate]

Değerli arkadaşlar hocalarım,

Aşağıdaki görebilieceğiniz gibi bir yazdır makrosu var ama bir koşula bağlamak istedim worksheet_change makrosunda AH1 ve Aİ1 hücreleri eşit değilse hiçbir şekilde yazdırmasın istiyorum msgBox ekledim ama Sub yazdır() durduramıyorum

Saygılarımı Sunuyorum

Sub yazdır()
Call unprotect
Call printpage
Call printpage1
Call printpage2
Call printpage3
Call protect
End Sub
Sub Worksheet_Change()
If [ah1].Value <> [ai1].Value Then Exit Sub
MsgBox ("Toplamlar Tutmuyor Kontrol Ediniz")
End Sub
Sub unprotect()
Worksheets("PRINTOUT").unprotect "ahmet"
End Sub
Sub printpage()
If Range("b6").Value = 0 Then Exit Sub
Range("A1:R30").Select
Selection.PrintOut Copies:=1, Collate:=True
End Sub
Sub printpage1()
If Range("b36").Value = 0 Then Exit Sub
Range("A31:R60").Select
Selection.PrintOut Copies:=1, Collate:=True
End Sub
Sub printpage2()
If Range("b66").Value = 0 Then Exit Sub
Range("A61:R89").Select
Selection.PrintOut Copies:=1, Collate:=True
End Sub
Sub printpage3()
If Range("b96").Value = 0 Then Exit Sub
Range("A91:R111").Select
Selection.PrintOut Copies:=1, Collate:=True
End Sub
Sub protect()
Worksheets("PRINTOUT").protect "ahmet"
End Sub

 

[dEdE]

Merhaba,
Aşağıdaki satırı yazdır makrosunun ilk üç satırı olarak ekleyip dener misiniz?

If [ah1].Value <> [ai1].Value Then 
MsgBox ("Toplamlar Tutmuyor Kontrol Ediniz")
Exit Sub
End If

 

[imyourfate]

ilginize çok teşekkür ediyorum

makroyu tam olarak nereye koymam gerektiğini anlayamadım?

 

[dEdE]

Merhaba,

Aşağıdaki gibi dener misiniz?

Sub yazdır()
If [ah1].Value <> [ai1].Value Then 
MsgBox ("Toplamlar Tutmuyor Kontrol Ediniz")
Exit Sub
End if
Call unprotect
Call printpage
Call printpage1
Call printpage2
Call printpage3
Call protect
End Sub

 

[imyourfate]

eşitsizlik durumunda makro yazdırmaya devam etti malesef çalışmadı

 

[dEdE]

eşitsizlik durumunda makro yazdırmaya devam etti malesef çalışmadı

Bu pek olası değil ama, şöyle bir düzeltme yaparak deneyelim. Sorun yine devam ederse örnek dosya eklemeniz gerekecek.

Sub yazdır()
If [AH1].Value <> [AI1].Value Then 
MsgBox ("Toplamlar Tutmuyor Kontrol Ediniz")
Exit Sub
End if
Call unprotect
Call printpage
Call printpage1
Call printpage2
Call printpage3
Call protect
End Sub

 

[imyourfate]

ilginize tekrar teşekkür ediyorum makro çalışmadı
ilgili makro modül2 de ilgili hücreler sayfa1 de

ekli dosya mevcuttur

saygılarımla

 

[imyourfate]

Değerli Hocam,

acil çıkmam gerekiyor size yazamazsam lütfen ilgisizlik olarak düşünmeyiniz

Saygılarımı sunuyorum
Hayırlı akşamlar

 

[dEdE]

Merhaba,
Aşağıdaki satırı
If [ah1].Value <> [ai1].Value Then
bununla değiştirmeniz yeterli olacaktır.

If Sheets("Sayfa1").[AH1].Value <> Sheets("Sayfa1").[AI1].Value Then

 

[imyourfate]

Hocam saygılarımı sunuyorum mükemmel olmuş

Hayırlı akşamlar Allaha emanet olunuz