الشافعي قام بنشر ديسمبر 20, 2016 مشاركة قام بنشر ديسمبر 20, 2016 السلام عليكم اخوتي الكرام ارجو لو تكرمتم شرح الكود هذا Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("U10")) Is Nothing Then Select Case Range("U10").Value Case Is = Range("W15").Value copy_basic copy_custom (15) Case Is = Range("W16").Value copy_basic copy_custom (16) Case Is = Range("W17").Value copy_basic copy_custom (17) Case Is = Range("W18").Value copy_basic copy_custom (18) Case Is = Range("W19").Value copy_basic copy_custom (19) Case Is = Range("W20").Value copy_basic copy_custom (20) Case Is = Range("W21").Value copy_basic copy_custom (21) Case Is = Range("W22").Value copy_basic copy_custom (22) Case Is = Range("W23").Value copy_basic copy_custom (23) Case Is = Range("W24").Value copy_basic copy_custom (24) Case Is = Range("W25").Value copy_basic copy_custom (25) Case Is = Range("W26").Value copy_basic copy_custom (26) Case Is = Range("W27").Value copy_basic copy_custom (27) Case Is = Range("W28").Value copy_basic copy_custom (28) Case Is = Range("W29").Value copy_basic copy_custom (29) Case Is = Range("W30").Value copy_basic copy_custom (30) Case Is = Range("W31").Value copy_basic copy_custom (31) Case Is = Range("W32").Value copy_basic copy_custom (32) Case Is = Range("W33").Value copy_basic copy_custom (33) Case Is = Range("W34").Value copy_basic copy_custom (34) Case Else MsgBox "البرنامج غير محدد سلفا", vbCritical End Select ElseIf Not Intersect(Target, Range("A10:A12")) Is Nothing Then If Range("A10") = 0 Then Range("A15,A17,A19,A21,A23,A25,A27,A29,A31,A33").EntireRow.Hidden = True Else Range("A15,A17,A19,A21,A23,A25,A27,A29,A31,A33").EntireRow.Hidden = False End If If Range("A12") = 0 Then Range("A16,A18,A20,A22,A24,A26,A28,A30,A32,A34").EntireRow.Hidden = True Else Range("A16,A18,A20,A22,A24,A26,A28,A30,A32,A34").EntireRow.Hidden = False End If Else If Me.[T1] Then Exit Sub If Not Application.Intersect(Target, Range("myrange")) Is Nothing Then Application.EnableEvents = False Application.Undo Application.EnableEvents = True End If Exit Sub End If End Sub Sub copy_basic() Set Sh2 = Sheet2 Sh2.Range("C11").Value = Range("B3").Value Sh2.Range("C12").Value = Range("AH98").Value Sh2.Range("H12").Value = Range("K3").Value Sh2.Range("J14").Value = Range("L7").Value Sh2.Range("J16").Value = Range("L10").Value Sh2.Range("J18").Value = Range("B7").Value Sh2.Range("J20").Value = Range("B5").Value Sh2.Range("J22").Value = Range("J5").Value Sh2.Range("J50").Value = Range("U7").Value Sh2.Range("J52").Value = Range("U3").Value Sh2.Range("J54").Value = Range("U5").Value Sh2.Range("J56").Value = Range("U12").Value Sh2.Range("L18").Value = Range("B8").Value Sh2.Range("O17").Value = Range("M5").Value Sh2.Range("O21").Value = Range("R5").Value Sh2.Range("O26").Value = Range("S3").Value Sh2.Range("p14").Value = Range("p7").Value End Sub Sub copy_custom(nos As Integer) Set Sh2 = Sheet2 Sh2.Range("J26").Value = Range("A" & nos).Value Sh2.Range("J28").Value = Range("B" & nos).Value Sh2.Range("J30").Value = Range("J" & nos).Value Sh2.Range("J32").Value = Range("K" & nos).Value Sh2.Range("J34").Value = Range("G" & nos).Value Sh2.Range("J36").Value = Range("R" & nos).Value Sh2.Range("J38").Value = Range("I" & nos).Value Sh2.Range("J40").Value = Range("O" & nos).Value Sh2.Range("J42").Value = Range("L" & nos).Value Sh2.Range("J44").Value = Range("D" & nos).Value End Sub رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.