سطر فى كود

[عبد القادر محمد مهدى]

للخيراء

عندما يتكرر هذا السطر

(Private Sub Worksheet_Change(ByVal Target As Range

فى أكتر من كود فى الصفحة يحصل تعارض فما الحل؟

[عبد القادر محمد مهدى]

للخيراء

عندما يتكرر هذا السطر

(Private Sub Worksheet_Change(ByVal Target As Range

فى أكتر من كود فى الصفحة يحصل تعارض فما الحل؟

[أبو عبد النور]

كل ورقة لها هذا الحدث الخاص بها

تجده مرة واحدة في كود الورقة.

[طلعت محمد حسن]

هذا السطر لا يتكرر اخي الكريم بل يكتب مره واحدة

[طلعت محمد حسن]

الورقة الواحدة اخي الكريم اقصد

[عبد القادر محمد مهدى]

السلام عليكم

استاذى أبو النور

اريد أن ادخل 2كود فى صفحة وكل كود يبدأ بهذا السطر

هل احذف هذا السطر من الكود الثانى؟

ورقة واحدة

[طلعت محمد حسن]

هذا ما كنت اقصدة يا اخي ابو عبد النور رد الاخ عبد القادر

[عبد القادر محمد مهدى]

ما من حل

[طلعت محمد حسن]

اخي الكريم ارفق ملف العمل واخبرنا ماذا تريد حتى يطلع الاخوة الاعضاء على مشكلتك ويحاولوا حلها

[أبو عبد النور]

4 ساعات مضت, عبد القادر محمد مهدى said:

اريد أن ادخل 2كود فى صفحة وكل كود يبدأ بهذا السطر

هل احذف هذا السطر من الكود الثانى؟

ورقة واحدة

 

لا اعلم ماذا لديك في الكود 2 من سطور ولكن لا يمكن تسمية اجرائين Procedures بنفس الاسم

[عبد القادر محمد مهدى]

اسلام عليكم

اريد أن ادخل هذان الالكود فى صفحة واحدة ولكن يحدث تعارض بينهما

الكود الأول

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
     If Not Intersect(Target, Range("d1:d10000")) Is Nothing Then
      VBA.Calendar = vbCalGreg
      If IsEmpty(Target) Then
         Target(1, 2).ClearContents
    Else
         With Target(1, 2)
               .Value = Date
               .EntireColumn.AutoFit
           End With
       End If
End IfEnd Sub

==============================

الكود الثانى

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRows As Integer, MyRange As Range, MyRange1 As Range
On Error GoTo 1
With Range("kh_test_1")
    MyRows = .Rows.Count - 1
    Set MyRange = .Range(Cells(MyRows, 1), Cells(MyRows, 4))
    If Not Intersect(Target.Cells(1, 1), MyRange.Cells) Is Nothing _
    And Target.Value <> "" Then
        MyRange.EntireRow.Insert
        Set MyRange1 = .Range(Cells(MyRows, 1), Cells(MyRows, 4))
        MyRange1.Value = MyRange.Value
        MyRange.ClearContents
    End If
End With
1 End Sub
 

[أبو عبد النور]

لماذا لا تدمجهما تحت واحد ؟

 

هكذا مثلا ً

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyRows As Integer, MyRange As Range, MyRange1 As Range

    If Target.Cells.Count > 1 Then Exit Sub
    
    If Not Intersect(Target, Range("d1:d10000")) Is Nothing Then
        VBA.Calendar = vbCalGreg
        If IsEmpty(Target) Then
            Target(1, 2).ClearContents
        Else
            With Target(1, 2)
                .Value = Date
                .EntireColumn.AutoFit
            End With
        End If
    End If
    
    On Error GoTo 1
    With Range("kh_test_1")
        MyRows = .Rows.Count - 1
        Set MyRange = .Range(Cells(MyRows, 1), Cells(MyRows, 4))
        If Not Intersect(Target.Cells(1, 1), MyRange.Cells) Is Nothing _
           And Target.Value <> "" Then
            MyRange.EntireRow.Insert
            Set MyRange1 = .Range(Cells(MyRows, 1), Cells(MyRows, 4))
            MyRange1.Value = MyRange.Value
            MyRange.ClearContents
        End If
    End With
1
End Sub

 

اقتباس

 

تم تعديل نوفمبر 26, 2016 بواسطه أبو عبد النور

[عبد القادر محمد مهدى]

أشكرك أستاذى/ أبو عبد النور

العلم نور

تم الدمج والحمد لله الكود شغال 100%

أشكرك استاذى الفاضل

جعل الله كل أعمالك الطيبة فى ميزان حسناتك

تحياتي لك استاذي

تم تعديل نوفمبر 27, 2016 بواسطه عبد القادر محمد مهدى