Страницы: 1
RSS
Worksheet_Change(ByVal Target As Range), не желает сотрудничать!
 
Уважаемый Дамы и Господа,  
 
Имеется вот такой вот Макрос, вставленный разумеется в коде листа.  
 
 
Private Sub Worksheet_Change(ByVal Target As Range)  
Application.ScreenUpdating = False  
Лист7.Unprotect ("")  
   'ПЕРВЫЙ ЗАКАЗ  
   Dim rng1 As Range: Set rng1 = [C8:D8]
   If Not Intersect(rng1, Target) Is Nothing Then  
   Module1.Hidden1  
   Module3.Hidden1  
End If  
   'ВТОРОЙ ЗАКАЗ  
   Dim rng2 As Range: Set rng2 = [C9:D9]
   If Not Intersect(rng2, Target) Is Nothing Then  
   Module1.Hidden2  
   Module3.Hidden2  
End If  
   'ТРЕТИЙ ЗАКАЗ  
   Dim rng3 As Range: Set rng3 = [C10:D10]
   If Not Intersect(rng3, Target) Is Nothing Then  
   Module1.Hidden3  
   Module3.Hidden3  
         
       'КОЛИЧЕСТВО МАСТЕРОВ  
       Dim rng11 As Range: Set rng11 = [C21:C21]
       If Not Intersect(rng11, Target) Is Nothing Then Module2.Master1Hidden  
     
       'КОЛИЧЕСТВО СМЕННЫХ МАСТЕРОВ  
       Dim rng12 As Range: Set rng12 = [C72:C72]
       If Not Intersect(rng12, Target) Is Nothing Then Module2.Master2Hidden  
     
       'КОЛИЧЕСТВО БРИГАДИРОВ  
       Dim rng13 As Range: Set rng13 = [C189:C189]
       If Not Intersect(rng13, Target) Is Nothing Then Module2.Brigadier1Hidden  
     
If Intersect(Target, Range("E24:AI3924")) Is Nothing Then Exit Sub  
If WorksheetFunction.Sum(Range(Target.Address)) > 0 Then Exit Sub  
 
Лист7.Range(Target.Address).Value = Range(Target.Address).Value  
Лист7.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, Password:=""  
End Sub  
 
 
Надо добавить к нему вот такую гадость:  
 
'If Target Is Nothing Then Exit Sub  
'If Range("AZ34").Value = "0" Then Exit Sub  
'If Range("AZ34").Value = (ЛОЖЬ) Then  
'   MsgBox "ОШИБКА ВВОДА ДАННЫХ", vbCritical, "ООО ''Рога и Копыта''"  
'   Target = ""  
'   Target.Select  
'End If  
 
Куда бы не вставлял и как бы не крутил, то Exit Sub у первоначального рано срабатывает, то MsgBox из гадости заклинивает и он его по кругу пускает.  
 
Помогите совокупить два кода=))  
 
Заранее спасибо!    
 
С уважением,  
Александр
 
Попробуйте как-то так:  
(в коде есть логические ошибки, всё можно сделать проще. Не увидев файла, ничего посоветовать не могу. Код не проверял)  
 
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   Application.ScreenUpdating = False  
   Лист7.Unprotect ("")  
 
   '  If Target Is Nothing Then Exit Sub - такого быть не может  
 
   If Val([AZ34]) = 0 Then
       MsgBox "ОШИБКА ВВОДА ДАННЫХ", vbCritical, "ООО ''Рога и Копыта''"  
       Application.EnableEvents = False    ' не забываем временно отключать сработку событий  
       Target.ClearContents: Target.Select  
       Application.EnableEvents = True    ' а потом включать обратно  
       Exit Sub  
   End If  
 
   'ПЕРВЫЙ ЗАКАЗ  
   Dim rng1 As Range: Set rng1 = [C8:D8]
   ' ...  
 
   Лист7.Range(Target.Address).Value = Target.Value    ' так проще  
   Лист7.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True  
End Sub
 
Спасибо EducatedFool!  
 
Немного подредактировал и макрос завелся!  
 
Я забыл про EnableEvents мне кажется вот в этом была основная ошибка!
Страницы: 1
Читают тему
Наверх
Loading...