Emad Karali

للرفع 

اخي سليم المشكلة ليست في هذا الكود Auto_sum

ولافي Sell و Buy و Close ل ولافي النتائج المشكلة في هذا الكود 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.EnableEvents = False
  If Not Intersect(Target, Range("$C$4:$H$43", "$K$4:$O$43")) Is Nothing _
   And Target.Count = 1 Then
   Emad
 End If
 Application.EnableEvents = True
End Sub

هذا الكود لايتحدث تلقائي يجب انا اكتب بنفسي في الخلية لكي يتحدث ولاكن لااريد انا اكتب اريد الكود يتحدث تلقائي كل م تغير الارقام بسبب المعادلات الموجودة هنا ("Range("$C$4:$H$43" ( المعادلات والصيغ تقراء من ملف اخر باستمرار تتغير يمكن كل جزء من الثانية يتغير رقم ) وانا اريد في الصفحة Sheet2 يحدث تلقائي ويكتب  Sell و Buy و Close بدون م اكتب شي بنفسي لكي يتحدث الكود ,,,,  يعني اريد يتعرف الكود على الخلاية ("Range("$C$4:$H$43"  وكل م تغير رقم واحد بسبب نواتج المعادلات والصيغ يتحدث الكود ويكتب حسب الشروط  Sell و Buy و Close

اتمنى اكون شرحة تمام 

استاذ سليم حاصبيا

لما اطبق الكود ىدون م احذف value يكتب لي في الخلية المطلوب زي الصوره ولاكن لايتحدث تلقائي   

ىبعد حذف value مثل م قلت لايكتب لي المطلوب ولاكن يكتب الصيغة الي موجودة في الكود    

بكده م يحتاج يتحدث تلقائي لان الكود انكتب في الخلية وماراح يتعرف على الخلية البرنامج الخارجي لان ضروري م يكون فيه غير  Sell و Buy و Close لااجل يتعرف عليه

اتمنى مساعدتك 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.EnableEvents = False
  If Not Intersect(Target, Range("$C$4:$H$43", "$K$4:$O$43")) Is Nothing _
   And Target.Count = 1 Then
   Emad
 End If
 Application.EnableEvents = True
End Sub

Sub Emad()
Dim H%

With Sheets("Main")
    H = .Cells(Rows.Count, "H").End(3).Row
   With .Range("k4:k" & H)
     .Formula = _
      "=IF(C4="""","""",IF(AND(C4<=0,D4>=0,F4<=0,G4<=0,H4<=-15,M4<=-13),""Sell"",""""))"
    
   End With
   
   With .Range("L4:L" & H)
    .Formula = _
     "=IF(C4="""","""",IF(AND(F4<=0,G4<=0,H4<=-15,M4<=-8),""Wait"",""Close""))"
       
   End With
    
    With .Range("N4:N" & H)
    .Formula = _
     "=IF(C4="""","""",IF(AND(F4>=0,G4>=0,H4>=15,M4>=8),""Wait"",""Close""))"
    
    End With
    
     With .Range("o4:o" & H)
    .Formula = _
     "=IF(C4="""","""",IF(AND(F4>=0,G4>=0,H4>=15,M4>=13),""Buy"",""""))"
  
    End With
 End With
End Sub

• قاها ، او اختر ملف...
• اضف مرفقات اخري 

• امتدادات الصور المسموح بها: zip, rar, jpg, gif, bmp, png, pdf, tif, jpeg, doc, docx, docxm, xls, xlm, xlsx, xlsm, ppt, pptx, pptm, pps, ppsm, ppsx, accdb, mdb, mpp, 7z, xlsb, docm
• الحد الاقصي: 967.9 kB

اخي الفاضل اشكر لك مجهودك الذي تقدمه للخير 

اعلم انني اخذت من وقتك وتعبتك معايا الكود ممتاز واشتغل تلقائي لاكن لايتفعل الى اذا كتبت في اي خلية اريد المعادلات في الخلايا هيا الي تشغل الكود تلقائي لااني رابط الملف بملف خارجي ياخذ البيانات منها وانا لااكتب شي ابدا ... اشكرك

Private Sub Worksheet_Change(ByVal Target As Range)
Dim H%
With Sheets("Sheet2")
    H = .Cells(Rows.Count, "H").End(3).Row
    .Range("k2:k" & H).Formula = _
      "=IF(AND(C2<=0,D2>=0,F2<=0,G2<=0,H2<=-15,M2<=-13),""Sell"","""")"
      .Range("k2:k" & H).Value = _
      .Range("k2:k" & H).Value
      
    .Range("L2:L" & H).Formula = _
     "=IF(AND(F3<=0,G3<=0,H3<=-15,M3<=-8),""Wait"",""Close"")"
      .Range("L2:L" & H).Value = _
      .Range("L2:L" & H).Value
     
     .Range("N2:N" & H).Formula = _
     "=IF(AND(F2>=0,G2>=0,H2>=15,M2>=8),""Wait"",""Close"")"
      .Range("N2:N" & H).Value = _
      .Range("N2:N" & H).Value
     
 End With
End Sub

عندما اكتب الكود بدخل حدث الصفحة يعلق الاكسل ويقفل اريد ان يكون تلقائي :,(

اخي الملف جدا ممتاز اشكرك ولاكن ينقصه شي واحد فقط  ان يكون تلقائي بدون زر 

تمام ي غالي اعتذر على عدم اضافة الملف المرفق

هذا الملف ليس الاصلي لاان الاصلي مربوط بملف اخر ف البيانات بتجي مكانها Error يوجد معادلات داخل الخلاية وليست موجودة داخل هذا الملف واريد الكود يتعرف على المعادلات .. وشكرا على المساعدة  

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RowNum, r, s, n As Long

    For RowNum = 2 To 40
        If Worksheets("Sheet2").Cells(RowNum, 3).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 4).Value >= 0 And Worksheets("Sheet2").Cells(RowNum, 6).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 7).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 8).Value <= -15 And Worksheets("Sheet2").Cells(RowNum, 13).Value <= -13 Then
           Worksheets("Sheet2").Cells(RowNum, 11).Value = "SELL"
          End If
       Next RowNum
           For r = 2 To 40
        If Worksheets("Sheet2").Cells(r, 6).Value <= 0 And Worksheets("Sheet2").Cells(r, 7).Value <= 0 And Worksheets("Sheet2").Cells(r, 8).Value <= -15 And Worksheets("Sheet2").Cells(r, 13).Value <= -8 Then
           Worksheets("Sheet2").Cells(r, 12).Value = "WAIT"
           Else
           Worksheets("Sheet2").Cells(r, 12).Value = "CLOSE"
          End If
        Next r
     For s = 2 To 40
        If Worksheets("Sheet2").Cells(s, 6).Value >= 0 And Worksheets("Sheet2").Cells(s, 7).Value >= 0 And Worksheets("Sheet2").Cells(s, 8).Value >= 15 And Worksheets("Sheet2").Cells(s, 13).Value >= 8 Then
           Worksheets("Sheet2").Cells(s, 14).Value = "WAIT"
           Else
           Worksheets("Sheet2").Cells(s, 14).Value = "CLOSE"
          End If
        Next s
        
        For n = 2 To 40
        If Worksheets("Sheet2").Cells(n, 3).Value >= 0 And Worksheets("Sheet2").Cells(n, 4).Value <= 0 And Worksheets("Sheet2").Cells(n, 6).Value >= 0 And Worksheets("Sheet2").Cells(n, 7).Value >= 0 And Worksheets("Sheet2").Cells(n, 8).Value >= 15 And Worksheets("Sheet2").Cells(n, 13).Value >= 13 Then
           Worksheets("Sheet2").Cells(n, 15).Value = "BUY"
           Else
           Worksheets("Sheet2").Cells(n, 15).Value = " "
          End If
        Next n
       
End Sub

اطلب من اخواني الكرام تعديل الكود تعبت اعدل فيه اريده يقراء من خلية يوجد بها معادلة واريده ان يكون تلقائي بدون زر لو تكرمتم 

نسخة من اوفيسنا.xlsm

اخي خيماوي اتمنى تنظر لموضوعي محتاج جدا الكود 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RowNum, r, s, n As Long

    For RowNum = 2 To 40
        If Worksheets("Sheet2").Cells(RowNum, 3).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 4).Value >= 0 And Worksheets("Sheet2").Cells(RowNum, 6).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 7).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 8).Value <= -15 And Worksheets("Sheet2").Cells(RowNum, 13).Value <= -13 Then
           Worksheets("Sheet2").Cells(RowNum, 11).Value = "SELL"
          End If
       Next RowNum
           For r = 2 To 40
        If Worksheets("Sheet2").Cells(r, 6).Value <= 0 And Worksheets("Sheet2").Cells(r, 7).Value <= 0 And Worksheets("Sheet2").Cells(r, 8).Value <= -15 And Worksheets("Sheet2").Cells(r, 13).Value <= -8 Then
           Worksheets("Sheet2").Cells(r, 12).Value = "WAIT"
           Else
           Worksheets("Sheet2").Cells(r, 12).Value = "CLOSE"
          End If
        Next r
     For s = 2 To 40
        If Worksheets("Sheet2").Cells(s, 6).Value >= 0 And Worksheets("Sheet2").Cells(s, 7).Value >= 0 And Worksheets("Sheet2").Cells(s, 8).Value >= 15 And Worksheets("Sheet2").Cells(s, 13).Value >= 8 Then
           Worksheets("Sheet2").Cells(s, 14).Value = "WAIT"
           Else
           Worksheets("Sheet2").Cells(s, 14).Value = "CLOSE"
          End If
        Next s
        
        For n = 2 To 40
        If Worksheets("Sheet2").Cells(n, 3).Value >= 0 And Worksheets("Sheet2").Cells(n, 4).Value <= 0 And Worksheets("Sheet2").Cells(n, 6).Value >= 0 And Worksheets("Sheet2").Cells(n, 7).Value >= 0 And Worksheets("Sheet2").Cells(n, 8).Value >= 15 And Worksheets("Sheet2").Cells(n, 13).Value >= 13 Then
           Worksheets("Sheet2").Cells(n, 15).Value = "BUY"
           Else
           Worksheets("Sheet2").Cells(n, 15).Value = " "
          End If
        Next n
       
End Sub

 لما يشتغل يكتب المطلوب ولاكن بعدها يطلع لي هذا الخطا 

وفي مشكلة الخلاية فيها معادلات م يشتغل الكود 

شكرا اخي خيماوي ممتاز لاكن هذا بزر وانا اريده تلقائي بدون م اضغط زر الله يجزاك خير 

عندي جدول كاتب فيه دالة عند تحقق شروط في الخمسة الخلايا الي قبل يكتب لي اما شراء او بيع او اغلاق 

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

اريد فقط لو تكرمتم تحويل الدالة الى كود تلقائي في نفس الشيت 

بحثت في الموقع عن موضوع ولم اجد شي قريب كتبت كود نجح معايا ولاكن فقط لصف واحد وانا اريد الصفوف كاملة  

اريد تغير بسيط اني اريد حذف عاموديناوفيسنا.xls الاغلاق واترك فقط عامود البيع والشراء وعند تحقق شرط الشراء يكتب شراء ولا تتغير الى اغلاق الى اذا تحقق شرط الاغلاق وكذلك في عامود البيع تركت العامود لااجل الدالة تتعرفو عليها  باذن الله مافي شي صعب عليكم اتمنى مساعدتكم

اوفيسنا.xls

ممكن احد يساعدني ولو بشي بسيط الله يجزاكم خير 

يتابع :(

بحثت في المنتدى م حصلت نفس الي ابغاه اتمنى تساعدوني في هذا الكود وربي محتاجه ضروري

عندي ملفين واحد HISTORY وواحد Le كل شي جاهز فقط اريد تعديل كود الترحيل واستعادة البيانات في ملف Le من ملف  HISTORY وهو مغلق اتمنى مساعدتكم الرقم السري للاكواد 1111

Le.rar

جزاك الله خير هوا المطلوب

اريد تغير خلية معينة بشرط كتابة كلمة ok أو pending أو progress في خلية يتغير في نفس الصف خلية معينة ب تاريخ اليوم ساعدوني في هذا الكود 

الرجاء ألمساعدة لحاجتي الشديدة لدي الطريقة

عندي مشكلة في مشاركة الملفات في مكان العمل لايمكن فتح ملف في جهازين في نفس الوقت وحفظ البيانات وعملت قاعدة بيانات ارحل واسترد منها البيانات ولكن بعد التجربة لايمكن الترحيل والاستيراد لان الملف مغلق ويجب فتحه هل يوجد طريقة ارحل البيانات واسترد منها والملف مغلق ؟ وهل يمكن ربط البيانات مع ملفين والملف مغلق ؟ 

شكرا اخي خالد الله يجزاك خير هوا المطلوب 

ممكن المساعدة

Sub Purchases_Today_Print()

Sheet27.[d1:k38].PrintOut

End Sub

السلام عليكم ممكن كود امر طباعة معقد شوية كود امر طباعة من d9 الى اخر خلية فيها بيانات اتمنى مساعدتكم

السلام عليكم اتمنى مساعدتكم في الكود احتاجه

هذا الملف ضفت فيه ورقة الترحيل اريد الترحيل واضافة التاريخ والعدد في صفحة المرحل لها تلقائي اتمنى تساعدني فيها 

material.rar

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

المصنف1.rar