الشافعي قام بنشر أبريل 17, 2014 مشاركة قام بنشر أبريل 17, 2014 عندي ملف اكسيل في كود وكل ما احول اضيف كود ثاني لا يقبل Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("U10")) Is Nothing Then Exit Sub End If 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 Else MsgBox "ÇáÈÑäÇãÌ ÛíÑ ãÍÏÏ ÓáÝÇ", vbCritical End Select End Sub Sub copy_basic() Set sh2 = Sheet2 sh2.Range("C11").Value = Range("B3").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 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 وهذا الكود اللي عاوز اضيفه في مع الكود السابق Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A10:A12")) Is Nothing Then Exit Sub If Range("A10") = 0 Then Range("A15,A17,A19,a21,a23,a25,a27,a29").EntireRow.Hidden = True Else Range("A15,A17,A19,a21,a23,a25,a27,a29").EntireRow.Hidden = False End If If Range("A12") = 0 Then Range("A16,A18,A20,a22,a24,a26,a28,a30").EntireRow.Hidden = True Else Range("A16,A18,A20,a22,a24,a26,a28,a30").EntireRow.Hidden = False End If End Sub رابط هذا التعليق شارك More sharing options...
الشافعي قام بنشر أبريل 18, 2014 الكاتب مشاركة قام بنشر أبريل 18, 2014 للرفع رابط هذا التعليق شارك More sharing options...
الشافعي قام بنشر أبريل 18, 2014 الكاتب مشاركة قام بنشر أبريل 18, 2014 جاري الكتابة وحل المشكلة رابط هذا التعليق شارك More sharing options...
الشافعي قام بنشر أبريل 18, 2014 الكاتب مشاركة قام بنشر أبريل 18, 2014 لللرفع رابط هذا التعليق شارك More sharing options...
الشافعي قام بنشر أبريل 19, 2014 الكاتب مشاركة قام بنشر أبريل 19, 2014 للرفع رابط هذا التعليق شارك More sharing options...
احمد عبد الناصر قام بنشر أبريل 19, 2014 مشاركة قام بنشر أبريل 19, 2014 السلام عليكم اعتقد لا يمكن تكرار حدث للصفحة Private Sub Worksheet_Change(ByVal Target As Range) جرب دمج الكودين 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 Else MsgBox "C?E??C?? U?? ??II ???C", 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").EntireRow.Hidden = True Else Range("A15,A17,A19,a21,a23,a25,a27,a29").EntireRow.Hidden = False End If If Range("A12") = 0 Then Range("A16,A18,A20,a22,a24,a26,a28,a30").EntireRow.Hidden = True Else Range("A16,A18,A20,a22,a24,a26,a28,a30").EntireRow.Hidden = False End If Else Exit Sub End If End Sub تحياتي رابط هذا التعليق شارك More sharing options...
الشافعي قام بنشر أبريل 19, 2014 الكاتب مشاركة قام بنشر أبريل 19, 2014 شكرا استاذ احمد وجزاك الله خير رابط هذا التعليق شارك 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.