Zorunlu alanlar doldurulmadan save etmesine izin vermesin

[haso_excel]

Merhaba arkadaşlar,

Ekdeki dosyamda, belli alanların doldurulması zorunlu. İlgli alanlarda en az a bir tane giriş olabilir.(bir kayıt = ilgli satır) Benim amacım bu alanların hepsi doldurulmadıysa dosyayı save etmeden bir kontrol makrosu ile, zorunlu alanlarda en az bir kayıt varmı(bir kayıt = ilgli satır) ve her alan dolu mu kontrolü. Değil ise save etmeden önce kullanıcının karşısına bir msgbox çıkacak ve hangi boş alan varsa o alanın doldurulmasını isteyecek ve save etmesine izin vermeyecek. Tabii bu farlı kullanıcılar tarafından doldurulacağı için, herkesin makro ayarları enable olmasa bile çalışacak şeklide olmalı. Bu mümkün mü? yardımlarınızı bekliyorum arkadaşlar.

 

[asi_kral]

Merhaba
Kitabınzın kod bölümünde bulunan Thisworkbook'a bu kodu kopyalayın ve deneyin.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim STR As Long, STN As Long
For STR = 2 To Cells(Rows.Count, "A").End(xlUp).Row
For STN = 1 To 9
If Cells(STR, STN) = Empty Then
MsgBox Cells(1, STN) & " Sütunun " & STR & " Satırı Boş", vbcriteria
Cells(STR, STN).Select
Cancel = False
End If
Next: Next
End Sub

 

[haso_excel]

Teşekkür ederim işlem tamam. elinize sağlık.

 

[haso_excel]

Ben işlem tamam dedim ama, formata göre değiklik yapıp çalıştırdığımda tamda istediğim gibi olmamış,
A9 ile I30 arasında ki alanda herhangi bir satırda olsa girişler, kabulümüzdür ancak. zorunlu alanları doldurulması şartı ile. Denemelerimde A kolonu boş olursa da save etmesine izin veriyordu. Gerçek formatım ekde rica etsem tekrar bir yardımcı olabilir misini lütfen?

 

[asi_kral]

Merhaba
Bununla değişir misiniz_?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim STR As Long, STN As Long
With WorksheetFunction
For STR = 9 To 30
If .CountIf(Range("A" & STR & ":I" & STR), "") < 9 Then
For STN = 1 To 9
If Cells(STR, STN) = Empty Then
MsgBox Cells(8, STN) & " Sütunun " & STR & " Satırı Boş", vbcriteria
Cells(STR, STN).Select
Cancel = False
End If
Next
End If
Next
End With
End Sub

 

[haso_excel]

Teşekkürler elinize sağlık işlem tamam

 

[asi_kral]

Teşekkürler elinize sağlık işlem tamam

Kolay Gelsin.