احتاج كود اظهار واخفاء صفوف بشرط

[الشافعي]

في المرفقات 

ملف احتاج كود اظهار واخفاء بعد الصفوف ولكن بشرط في الخلية G5

AM.xlsm

[سليم حاصبيا]

جرب هذا الماكرو

مجرد ان تختار اي قيمة من  الخلية G5  او الخلية   M5  يقوم الماكرو بتنفيذ عمله

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
 If Target.Address = "$M$5" Or Target.Address = "$G$5" Then
 Me.Cells.Rows.Hidden = False
  Select Case Target.Address
   Case "$M$5"
   hide_rows1
   Case "$G$5"
   hide_rows2
   End Select
 End If
Application.EnableEvents = True
End Sub


Sub hide_rows1()
Dim my_Rg As Range
Set my_Rg = Range("a15:a16")
Select Case Range("M5").Value
 Case "لا": my_Rg.Rows.Hidden = True
 Case Else: my_Rg.Rows.Hidden = False
 End Select
End Sub
Sub hide_rows2()
Select Case Range("G5").Value
  Case "جديد"
 Range("a19:a22").Rows.Hidden = False
 Range("a23:a38").Rows.Hidden = True

  Exit Sub
  '======================
  Case "اعادة"
 Range("a19:a22").Rows.Hidden = True
 Range("a23:a38").Rows.Hidden = False
  Exit Sub
  '======================
  Case "تكميلي"
   Range("a27:a31").Rows.Hidden = False
   Range("a19:a22").Rows.Hidden = True
   Range("a36:a38").Rows.Hidden = True
    
  Exit Sub
 '++===========================
 Case "سداد"
   Range("a27:a31").Rows.Hidden = True
   Range("a19:a22").Rows.Hidden = True
   Range("a36:a38").Rows.Hidden = False
  Case Else
  
 End Select
End Sub

 

 

 

AM_salim.xlsm

[الشافعي]

شاكر ومقدر لك استاذ الكريم سليم 

ربنا يزيدك من العلم ويجعله في ميزان حسانتك 

انا الان جالس اجرب الكود

 

تم تعديل أغسطس 26, 2019 بواسطه الشافعي

[الشافعي]

الاستاذ سليم الموقر

هل اقدر الغي الاعتماد على الخلية M5 ويكون الاعتماد على الخلية G5 فقط 

وهل كذا يكون صح ولا يحتاج تعديل

 

 

 

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
 If Target.Address = "$G$5" Then
 Me.Cells.Rows.Hidden = False
  Select Case Target.Address
   Case "$G$5"
   hide_rows1
   End Select
 End If
Application.EnableEvents = True
End Sub

Sub hide_rows1()
Select Case Range("G5").Value
  Case "جديد"
 Range("a19:a22").Rows.Hidden = False
 Range("a23:a38").Rows.Hidden = True

  Exit Sub
  '======================
  Case "اعادة"
 Range("a19:a22").Rows.Hidden = True
 Range("a23:a38").Rows.Hidden = False
  Exit Sub
  '======================
  
  Case "تكميلي"
   Range("a27:a31").Rows.Hidden = False
   Range("a19:a22").Rows.Hidden = True
   Range("a36:a38").Rows.Hidden = True
    
  Exit Sub
 '++===========================
 Case "سداد"
   Range("a27:a31").Rows.Hidden = True
   Range("a19:a22").Rows.Hidden = True
   Range("a36:a38").Rows.Hidden = False
  Case Else
  
 End Select
End Sub

تم تعديل أغسطس 26, 2019 بواسطه الشافعي

[سليم حاصبيا]

ممكن هذا المر 

لكن في هذاه الحالة الافضل ان توقف الماكروين الاخرين لعدم تكبير حجم الملف  (بوضع فاصلة عليا عليهما) والاكتفاء بهذا الكود

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
 If Target.Address = "$G$5" And Target.Count = 1 Then
 Me.Cells.Rows.Hidden = False
 Select Case Range("G5").Value
Case "جديد"
 Range("a19:a22").Rows.Hidden = False
 Range("a23:a38").Rows.Hidden = True
Case Else
 Range("a19:a22").Rows.Hidden = True
 Range("a23:a38").Rows.Hidden = False
End Select

  End If
Application.EnableEvents = True
End Sub

 

[الشافعي]

شكرا جزيل الشكر استاذ العزيز سليم

وربي يبارك فيك وفي صحتك تم عمل اللازم