اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم ورحمة الله وبركاته

إخواني الكرام في المنتدى الأغر

 

معكم في موضوع جديد وشيق ومفيد ، مع عالم الإكسيل ومع كل جديد ، ومع تنشيط لخلايا المخ اللي تخلي مخك حديد .. أقدم لكم المزيد والمزيد ، لعل الجميع يستفيد ، ويستضاء بنا ولو من بعيد (شكلي سرحت ..أعتذر عن المقدمة الطويلة يا أبو عيد) :rol: :rol:

 

معنا اليوم فورم بسيط (فيه صندوق الدنيا (صندوق نص) TextBox وزر أمر Command Button)

بالنسبة لصندوق النص غيرت فيه من الخصائص حاجتين اتنين وبس .. خاصية اسمها MultiLine ودي خليتها True ودي عشان تقدر سعادتك تكتب في أكتر من سطر

والخاصية التانية EnterKeyBehavior ودي بردو True ودي عشان تقدر بعد ما تكتب سطر تضغط Enter يقوم ايه ؟؟ يقوم ينتقل للسطر اللي بعديه .. وهكذا وهكذا

يعني تكتب كلمة البحث المراد البحث عنها وتضغط إنتر ، وتقدر تكتب كلمة تانية وتضغط إنتر ، وتقدر تكتب كلمة تالتة وتضغط إنتر ، وتقدر تكتب كلمة ( - - - - - ) كتبتها بالحبر السري عشان محدش ياخد باله وتضغط إنتر وهكذا وهكذا

ولما تدوس على زر الأمر Search هتلاقي النتائج المراد البحث عنها تم تلوينها

 

جرب مثلاً اكتب Yasser واضغط إنتر ، واكتب في السطر اللي بعديه "ياسر" من غير أقواس تنصيص واضغط إنتر ، وأخيراً دوووووس على زر الأمر وشوف النتائج

 

ودا شكل الكود الموضوع في زر الأمر

Private Sub CommandButton1_Click()
  Dim Cell As Range, Keys, Key, I As Long

  If Me.TextBox1.Value = "" Then Exit Sub

  Sheets("Sheet1").Cells(1).CurrentRegion.Font.ColorIndex = xlAutomatic

  Keys = Split(TextBox1.Value, vbCrLf)

  For Each Cell In Sheets("Sheet1").Cells(1).CurrentRegion.Columns(1).Cells
      For Each Key In Keys
          I = InStr(1, Cell.Value, Key)
          If I > 0 Then
             Cell.Characters(I, Len(Key)).Font.Color = vbRed
          End If
      Next Key
  Next Cell
End Sub

أرجو أن يكون الملف مفيد للجميع ..

تقبلوا تحياتي وهكذا وهكذا :fff: :fff: :fff:

Multiple Search & Color Results.rar

  • Like 6
قام بنشر

الأخ الغالي ياسر فتحي

الأخ الحبيب صلاح الصغير

الأخ نايف - م

مشكور على مروركم العطر .. وبارك الله فيكم

 

الأخ صلاح الملف يعمل معي بشكل طبيعي وكذلك الأخ نايف .. وننتظر رأي باقي الأخوة في الملف .. هل يعمل أم أن به مشكلة لدى أحد آخر؟

ما هي نسخة الأوفيس التي تعمل عليها ؟ وهل هناك إضافات AddIns قد تسبب مشاكل لك كما حدث آنفاً ..

 

 

تقبلوا تحياتي

قام بنشر

الاستاذ ياسر المحترم

شكرا لمجهودك الرائع ... جعله الله في كفة حسناتك

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

 

اخي المحترم

نريد كود بحث مثل هذا الجمال يبحث عن شهاده معينه لانها بتدوخنا

قام بنشر

من لم يعمل معه الكود الأول فليجرب هذا الكود وليعلمنا بالنتيجة

Private Sub CommandButton1_Click()
  Dim Cell As Range, Keys, Key, I As Long

  If Me.TextBox1.Value = "" Then Exit Sub

  Sheets("Sheet1").Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Font.ColorIndex = xlAutomatic

  Keys = Split(TextBox1.Value, vbCrLf)

  For Each Cell In Sheets("Sheet1").Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
      For Each Key In Keys
          I = InStr(1, Cell.Value, Key)
          If I > 0 Then
             Cell.Characters(I, Len(Key)).Font.Color = vbRed
          End If
      Next Key
  Next Cell
End Sub

قام بنشر (معدل)

ا / ياسر 

الكود الاول يعمل جيدا الان و الثانى ايضا

فعلا كان فى AddIns و تم ازالتها ايه بقى مشكلة الاكواد مع الكثير من AddIns

هو بس مشكلته انه حساس قوى لازم اكتبله الكلمة بالظبط

تم تعديل بواسطه صلاح الصغير
  • Like 1
قام بنشر

السلام عليكم ورحمة الله وبركاته

 

ما شاء الله عليك يا ابو البراء ابدع بلا حدود في كل المواضيع التي تقوم بكتابتها جعل الله هذا العمل في ميزان حسناتك 

 

ونترقب المزيد من المواضيع المميزة  :biggrin2: 

 

ولكم تحياتي

  • Like 1
قام بنشر

أخي الكريم ياسين أبو وسام

جزيت خيراً على كلماتك الطيبة وعلى مرورك الكريم

ونترقب مساهمات فعالة ومفيدة إن شاء الله ..( الدنيا خد وهات زي اللعبة الحلوة خد وهات ، ومتحلاش إلا لما تفيد وتستفيد :wink2: )

تقبل تحياتي

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information