عبد الفتاح كيرة

هذه هى الألوان بالتنسيق الشرطى حسب المطلوب أما الطلب الأخير فغير واضح لدى kemasالملف.rar

عليكم السلام و رحمة الله هذا الكود نقلته لك من فترة وهذا تعديل ليتوقف بعد كل نتيجة بحث ليسألك هل تريد الاستمرار؟ For Each oSheet In ActiveWorkbook.Worksheets oSheet.Activate oSheet.[a1].Activate Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not Firstcell Is Nothing Then Firstcell.Activate MsgBox ("Found " & Chr(34) & WhatToFind & Chr(34) & " in " & oSheet.Name & "!" & Firstcell.Address) If MsgBox("next.......?", vbYesNo) = vbNo Then GoTo 1 On Error Resume Next While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address) Set NextCell = Cells.FindNext(After:=ActiveCell) If Not NextCell.Address = Firstcell.Address Then NextCell.Activate MsgBox ("Found " & Chr(34) & WhatToFind & Chr(34) & " in " & oSheet.Name & "!" & NextCell.Address) End If Wend End If Set NextCell = Nothing Set Firstcell = Nothing Next oSheet End If MsgBox ("End of Search") ActiveWindow.ScrollWorkbookTabs Position:=xlFirst Sheets("TOC").Select 1 End Sub السطر المعدل If MsgBox("next.......?", vbYesNo) = vbNo Then GoTo 1 الملف المرفق كود ممتاز للبحث فى كل ا2لشيتات.rar

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

أخى الفاضل الملف يعمل عندى بطريقة سليمة أرجو أن يجربه أحد الإخوة الخلية a1 فى الشيت الأول مرتبطة بمثيلتها فى الشيت الثانى هل الماكرو مفعل عندك؟

الكود فى الصفحة الأولى Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("a1")) Is Nothing Then Sheets(2).Range("a1") = Sheets(1).Range("a1") End If End Sub و فى الصفحة الثانية Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("a1")) Is Nothing Then Sheets(1).Range("a1") = Sheets(2).Range("a1") End If End Sub المرفقات conect-kemas.zip

تفضل الكود Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("i3:j3")) Is Nothing Then If Range("j3") = Range("i3") Then Range("e3:h3").ClearContents End If End If End Sub كود-kemas.rar

الكود فعلا مصمم للعمل لآخر صف فى الشيت جرب أن تملأ أكثر من 18 صفا

الأستاذ الفاضل / زين هكذا تبدو مشاركتك عندى ما هذا؟

الأخ الأستاذ أبو هاجر إذا كنت رفعت الصور فيمكنك بكل بساطة نسخ رابط الصورة كأى صورة إذا كنت تستخدم متصفح وندوز العادى انقر بالزر الأيمن على الصورة و اختر خصائص و ستجد بها الرابط و مع المتصفحات الأخرى الطريقة سهلة و بنفس الفكرة شاهد فديو أعددته خصيصا لذلك

شكرا لك يا أخى و ننتظر المزيد

ضع الكود التالى فى كائن workbook_open Private Sub Workbook_Open() Sheets(1).Select End Sub

شكرا على الشرح هناك طريقة سهلة جدا لرفع الصور - ملفات الفديو - الصوتيات - ملفات إكسل و وورد - ملفات pdf... و ذلك عن طريق البريد و تعطيك هذه لطريقة روابط دائمة و مباشرة لملفاتك هذه دائمة لا تحذف أبدا مباشرة لا تحتاج لفتح صفحة تحميل الطريقة : - أرسل رسالة من بريدك للعنوان التالى post@posterous.com - ضع بالمرفقات ما تريد مثلا صورة أو ملف mp3 أو ملف فديو أو ملفا نصيا - أرسل الرسالة بعد قليل سيأتيك الرد و فيه رابط لملفاتك التى رفعتها انتقل للرابط ستجد صورك أو ملفاتك انسخ رابطها و أدرجه هنا كصورة مثلا أما الأنواع الأخرى فيتم عرضها فى نفس الموقع و هذه صفحتى بالموقع المذكور فيها مئات الرسائل مرفوعة بنفس الطريقة

آخر اسم هو محمود سيد حسن السيد عدد الصفحات73 صفحة Book1kemas.rar

شكرا أستاذى بارك الله فيك

من أين نعرف أولا : الطالب الغائب ثانيا : من لم يسمع المقطع

شكرا للجميع بارك الله فيكم

أرفق الملف

تفضل Private Sub Worksheet_Change(ByVal Target As Range) Range("A1").Locked = True ActiveSheet.protect Contents:=True End Sub حماية خلية بالكود.rar

طبعا لا يظهر 4 000 سطر فى نافذة الطباعة أنت الآن فى الصفحة الأولى هناك زر تغيير للصفحة التالية

شكرا لك أستاذى بارك الله فيك

انقرأعلى الشيت بداية التحديد ثم اضغط ctrl + shift + end

عليكم السلام و رحمة الله أشكرك أخى خالد لمرورك و كلامك الطيب بارك الله فيك

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

ما معنى هذا؟

راجع هذا الشرح