نجوم المشاركات

استاذ عبد العزيز الكود موجود في حدث الورقة علي العموم هذا هو الكود ان كان هو طلب السائل ............. توضيح الكود للاستاذ " ياسر خليل " Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("A1:A100")) Is Nothing Then Cancel = True Target.Font.Name = "Marlett" If Target = vbNullString Then Target = "a" Else Target = vbNullString End If End If End Sub

فكرة رائعة بارك الله فيك وهنا تطوير للفكرة وبالمرفق مزيد من الشرح الماكرو تم وضعه في حدث الصفحة change تنبيهات 2.rar

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

بسم الله الرحمن الرحيم اقدم لكم اليوم هديه برنامج صلاحيات المستخدمين ويمتاز هذا البرنامج بالتالى : ولكن قبل ان نبين مميزات البرنامج لابد من حفظ الحقوق فلقد بداء هذا البرنامج الاستاذ الفاضل / عبد الله المجرب واتم العمل من استكمال للاكواد وعمل التعديلات المطلوبه وتامينه فهو الاستاذ / عباد ابو نصار وتم الاستعانه بكود من مشاركات الاستاذ / عبد الله باقشير فى التنقل لاى صفحه فى المستند والان وقد اكتمل العمل ولكنه قابل للتطوير من الاستاذة الافاضل طبعا وهذا ما نطمح اليه مميزات البرنامج 1- انه سهل الاستخدام فانه يعمل بمجرد ان ترفق له اى عدد من الصفحات تصل الى 254 صفحه وقابله للزيادة عند تعديل جزء صغير فى الكود 2- اعطاء الصلاحيات عن طريق نموذج سهل الاستخدام وبيسر فهو يعطى ثلاث انواع من الصلاحيات (مشاهدة وتعديل اى صلاحيات كامله - مشاهدة فقط - اى للاطلاع - مخفى اى اخفاء هذة الصفحه عن المستخدم 3- يتم تسجيل اسم المستخدم والتاريخ والوقت لكل حركه دخول 4- صفحه mydate هى الصفحه الهامه فى الملف ففيها يتم تسجيل كل الصلاحيات واسماء المستخدمين وكلمات السر الخاصه بهم 5- مرونه عاليه فى الغاء واضافه الصفحات وتغير اسماءها دون التاثير على البرنامج فمبجرد اغلاق البرنامج والدخول عليه يتم تحديث بياناته تلقائيا 6- غير قابل الاختراق عن طريق رفع الامان فى الماكرو 7- الصفحات الرئيسيه فيه هى صفحه mydate وورقه رقم 1 وما دون ذلك قابل للحذف او التغيير المسمى او الاضافه ويتعامل كما ذكرت سابقا حتى 254 صفحه بعد اذن الاستاذة الافاضل / مصممي البرنامج قمت بوضعه فى هذة المشاركه بهدف ان تعم الفائدة من علمكم الغزير وكذلك اعتبارة برنامج قابل للتطوير وذلك لسهوله فكرته ومرونته فى التغيير حسب متطلبات كل شخص لان المشكله التى كانت تواجه اى مستخدم عادى عندما يجد ملف عن نفس هذا الموضوع هو كيفيه تطويعه الى الطريقه التى يعمل بها اما فى هذا الملف فما عليه سوى نقل الصفحات التى يرغبها من ملفاته وسوف يعمل عليها البرنامج بشكل تلقائى وسهل للدخول على البرنامج بصلاحيات كامله : اسم المستخدم : الدعم الفنى كلمه السر 111 ومن داخل صفحه mydate ستجد باقى الاسماء ومعها كلمات السر الخاصه بها عندما تكتب كلمه السر الخاصه بالدعم الفنى ستجد ازار الصلاحيات وكلمه السر تم تفعيلها ومن ثم تسطيع التجول فى البرنامج ومن داخله ايضا تستطيع تغيير كلمه السر صلاحيات المستخدم_.rar

السلام عليكم إخوتي خبراء إكسيل الكرام: طرح علي اﻷخ westexcel سؤالا ظنا منه أنني مهندس في مجال البرمجة وبما أنه في مجال بحركم الواسع الذي تخوضون غماره فإنني أحيل سؤاله عليكم رغبة بمساعدته. فالدال على الخير كفاعله أقدم لكم السؤال الذي طرحه..ولكنني أطلب منه فضلا لا أمرا تعريب اسمه الكريم ...ومتابعة هذا الموضوع ليقوم بإدراج الملف والبيانات التي تساعدكم ﻹيصاله إلى شط اﻷمان في هذه المسألة...وكلي رجاء أن تقدموا ما تستطيعوه ...تقبلوا تحياتي العطرة.. ما هي طريقة برمجة الحروف مع الآرقام يعني ا ب ت ث ج ح خ د ذ ر ز س ش ص ض ط ظ ع غ ف ق ك ل م ن هـ و ي 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 1110 9 8 7 6 5 4 3 2 1 يعني كل حرف يقابله رقم حسب الترتيب من أ -ي 28-1 وعندما اكتب عبارة في خانة الكتابة تظهر لي نتيجة الحروف يعني مثلا كتبت " الصحة" تظهر النتيجة بعد الجمع 26+5+14+23+1 = 69 يعني انا الذي اريده تظهر لي النتيجة مباشرة 69

وأنا كذلك أرى ما رأيت أخي م. ياسر بارك الله بكم جميعا.

الأستاذ والأخ الفاضل / عبد العزيز البسكري أرى فيك شعلة نشاط للرد على معظم الإخوة الأعضاء جزاك الله خيرا وجعله فى ميزان حسناتك

بارك الله فيك أخي الكريم محمد الخازمي على التّوضيح .. ومرّة أخرى أجد أنّ الملف فارغ .. ليس هو المهم ربّما الخلل من عندي رغم أنّ بقيّة الملفات تشتغل بطريقة عادية أستاذنا القدير ياسر خليل أبو البراء .. بارك الله فيك على الكود المميّز .. جزاك الله خيرًا و زادها بميزان حسناتك .. أفضالك علينا كثُرت .. بغيابك أو بحضورك .. ماشاء الله عليك سيّدي الكريم أتمنى أن يجد الأخ الكريم محمد رورو ما يرضيه ويفي بالغرض .. خالص احتراماتي

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

السلام عليكم استاذ محمد سؤال جميل ..... وموضوع يستحق المتابعة لنتعلم كيف الطريق ....... اساهم معك ببكود .... الاستاذ هشام شلبي ..... عثرت عليها سابقاً هو مختلفة لكن ممكن تستعين به و يساعدك بفكرة ما الجمع في خلية.rar الجمع في خلية.rar

السّلام عليكم و رحمة الله و بركاته أخي الكريم abo jana14 بانتظار ملف أستاذنا الغالي KHMB .. يمكن لك أخذ فكرة ولو بسيطة عن الموضوع في هذا الرابط : http://www.officena.net/ib/topic/63809-ممكن-كود-عمل-صلاحية-للفورم-لمدة-محدودة-استخدم-اكسل-2010/ فائق احتراماتي

السلام عليكم ورحمة الله وبركاتة ارفقت ملف قمت بعمل فكرة به كانت قد طلبت مني في العمل والفكرة تقوم على عمل تنبية بعد مقارنة اليوم الحالي بتاريخ اخر فأذا تطابق الشرط الموجود بالخلية "ِA1" يتم عمل تنبية بعدد تلك الحالات يشبة الموجود في الفيس بوك ثم بالضغط على أيقونة التنبيهات يتم ترحيل البيانات لصفحة التنبيهات لعلها تفيد احد الزملاء والملف مفتوح للاستفادة والتطوير بمقابل طبعا" ان تذكروني بدعواتكم تنبيهات.rar

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

جرب هذا الملف انه يعمل بشكل آلي بمجرد ما تغير شيئاَ في الجدول الثاني لائحة جاهزة اسعار الجملة 2015 salim.zip

السلام عليكم ورحمة الله أخي الكريم، أعتقد أنه يجب وضع الكود المعني في موديول مستقل Standard Module وليس مثل ما فعلت بوضعه في All Open Workbooks ثم ربطه بـ زر Button في أي شيت من الشيتات... والله أعلى وأعلم أخوك بن علية

السلام عليكم استاذى ياسر خليل ابو البراء والله اود ان لا اترك المنتدى ابدا ولكن ظروفى لا تسمح لى بالوقت الكافى وان شاء الله فى الفتره القادمه سأحاول ان اكون متواجد دمت بخير

السلام عليكم الفكرة جميله وتنفع فى جدولة الأعمال او اعياد الميلاد لكن فيها خطأ برمجى صغير فى السطر expd = Worksheets("Notifications").Range("A2") المفروض انه يقرا من الخلية A1 فى الشيت Main expd = Worksheets("Main").Range("A1") وكمان تبقى افضل لو حدد ادنى للتاريخ انه ما يكونش اقل من تاريخ اليوم لانى لاحظت انه جايب لى تنبيهات من سنة فاتت بتغيير السطر التالى If (.Cells(irow, 7) - MyDate) <= expd Then الى If (.Cells(irow, 7) - MyDate) <= expd And (.Cells(irow, 7) - MyDate) > -1 Then تنبيهات 1.rar

السلام عليكم ضع في زر امر اخفاء Application.SetHiddenAttribute acTable, "YourTable", True وفي زر اظهار Application.SetHiddenAttribute acTable, "YourTable", False DB1.rar

السلام عليكم ورحمة الله تم تعديل الملف في شيت "واجهه" وتعديل معادلات أيام كل شهر (معادلات تلقائية تحدد أيام الشهر بمجرد كتابة رقم الشهر في الخلية المناسبة بالأعلى)... أرجو أن يكون المطلوب بن علية خط سير شهرى4.rar

استاذي الفاضل / عباد المحترم السلام عليكم ورحمه الله وبركاته اسعدني مرورك واتمنى المتابعه معنا هنا فلا تحرمنا تواجدك معنا والاستفادة من علمكم الوفير وهذة نسخ من البرنامج باصدارات 2003 و 2007 صلاحيات المستخدم 2003-_.rar صلاحيات المستخدم_- 2007.rar

جزاك الله خير اخي himass اكيد بيستفيد منه الكثير حبذا ترفق نسختين نسخه 2003 واخر 2007 تقبل مروري

الاخوة الزملاء لعبة تركيب صورة للاطفال على اكسل 2010 لعبة تساعد الطفل على التعرف على الصورة ثم اعادة تركيبها وهى فكرة الاخ عبد الله باقشير تحريك اجزاء صورة على الرابط http://www.officena.net/ib/index.php?showtopic=41620 لعبة الصورة المتحركة.rar

اليوم اقدم لكم أضخم كتاب عربي لتعلم برنامج EXCEL يحتوي على شرح مفصل لصيغ والدوال وكذالك مرفق مع الكتاب تطبيقات نموذجية . غلاف الكتاب المحتويات 1.بداية الكتاب معلومات اساسية عن برنامج إكسل 2007 2. استخدام الدالات في الصيغ 3. شرح كافة المعادلات في والتطبيق في إكسل 4. شرح صيغ الصفيف وأمثلتها المستحيلة في إكسل 5. شرح جداول Pivot والمراجع الدائرية المقصودة والمخططات والرسوم البيانية والتنسيق الشرطي والادوات والتنقيح 6.في النهاية الغير متوقعة شرح لغة VBA وطريقة كتابة الصيغ فيها لتحميل الكتاب اضغط هنا حجم الكتاب: 39.7 MB رابط اخر على 4shared أرجو الدعاء لي ولصاحب الكتاب وناشره جزاكم الله خيرا

اخي عبد العزيز انت ما دمت تزيد عني علما فانت استاذي وهذا شرف لي وكونك اخي لي هذا شرف اكبر الموضوع ان الملف الذي اعمل سوف يكون فيه بيانات تخص المستخدم فانا لاريد ان اضره بغلق البيانات الخاصه به ولكني اريد غلق مايخصني في الملف فقط حتي اذا لم يرذ استخدام الملف مره اخري (A,B,C,D,E,F ) يمكنه نسخ بياناته بسهوله فمثلا اريد اخفاء صفحات الملف كامله ماعدا الاعمده من الصفحه الاولي

الأخ الكريم غرب الإكسيل (متخليك شرق عشان تكون معانا) جرب الدالة المعرفة التالية علها تفي بالغرض Function CalcString(S As String) Dim ArrLetters, ArrValues, X() As Byte, SpaceCounter As Long Dim I As Long, Counter As Long, Pos& ArrLetters = Join(Array("أ", "ا", "إ", "ب", "ت", "ث", "ج", "ح", "خ", "د", "ذ", "ر", "ز", "س", "ش", "ص", "ض", "ط", "ظ", "ع", "غ", "ف", "ق", "ك", "ل", "م", "ن", "ه", "ة", "و", "ي")) ArrValues = Array(1, 1, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 26, 27, 28) X = StrConv(S, vbFromUnicode) For I = 0 To UBound(X) Pos = InStr(ArrLetters, Chr(X(I))) If Pos > 0 Then Counter = Counter + ArrValues((Pos - 1) / 2) Next I SpaceCounter = SpaceCount(S) CalcString = Counter - SpaceCounter End Function Function SpaceCount(ByVal strLine As String) As String Dim Str As String Dim TempCount As Long Dim I As Long Str = Trim(strLine) TempCount = 0 For I = 1 To Len(Str) If Mid(Str, I, 1) = " " Then TempCount = TempCount + 1 Else If TempCount > 0 Then SpaceCount = SpaceCount & " " & TempCount TempCount = 0 End If End If Next I SpaceCount = Mid(SpaceCount, 2) End Function وإليك الملف المرفق Sum Letters.rar

المرفق في الموضوع السابق هو اختصار لملف وليس الملف كامل اخي عبدالعزيز

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

السّلام عليكم و رحمة الله و بركاته أخي الكريم محمد الخازمي .. الملف الذي أرسلته أراه فارغًا من الكود .. على كلٍّ قد ملأته بما كنتَ تقصده .. وبالإمكان تغيير تسمية النطاقات التشيك بوكس.rar

السلام عليكم ورحمة الله بأي طريقة تريد الفترة التجريبية 1- بعدد مرات فتح الملف 2- او بتاريخ معين يوم اسبوع شهر .... إلخ. ابو الحسن والحسين

بعد إن الاستاذ ياسر الأخ أكرم جلال أنا نزلت الملف وجربته كله شغال تمام ووبخصوص السطر ده .ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyFile لازم تروح على بارتشن d وتعمل ملف باسم new وهو ده اللي بيتحفظ فيه الملف بصيغة pdf

اخى عبد العزيز جرب ايضا الكود الاتى Sub hima_trs2() Dim LR As Long Dim LR1 As Long Dim WS As Worksheet Dim WS1 As Worksheet Set WS1 = Worksheets("ترحيل الفاتورة") Set WS = Worksheets("فاتورة بيع") If WorksheetFunction.CountIf(WS1.[C3:C10000], WS.[f6]) <> 0 Then MsgBox "This invoice already exist, No shift will done": Exit Sub LR1 = WS.Range("a11").End(xlDown).Row With WS.Range("a11:h" & Cells(Rows.Count, "a").End(xlUp).Row) If .Row = 11 Then LR = WS1.Cells(Rows.Count, "B").End(xlUp).Row + 1 WS1.Cells(LR, "B").Resize(.Rows.Count, 1).Value = WS.[f7] WS1.Cells(LR, "C").Resize(.Rows.Count, 1).Value = WS.[f6] WS1.Cells(LR, "D").Resize(.Rows.Count, 1).Value = WS.[c6] WS1.Cells(LR, "e").Resize(.Rows.Count, 1).Value = WS.[c7] WS1.Cells(LR, "f").Resize(.Rows.Count, 1).Value = WS.Range("h11:H" & LR1).Value WS1.Cells(LR, "g").Resize(.Rows.Count, 1).Value = WS.Range("g11:g" & LR1).Value WS1.Cells(LR, "h").Resize(.Rows.Count, 1).Value = WS.Range("f11:f" & LR1).Value WS1.Cells(LR, "i").Resize(.Rows.Count, 1).Value = WS.Range("e11:e" & LR1).Value WS1.Cells(LR, "j").Resize(.Rows.Count, 1).Value = WS.Range("d11:d" & LR1).Value WS1.Cells(LR, "k").Resize(.Rows.Count, 1).Value = WS.Range("c11:c" & LR1).Value WS1.Cells(LR, "l").Resize(.Rows.Count, 1).Value = WS.Range("b11:b" & LR1).Value End If End With End Sub تقبل تحياتى

انا مش فاهم ارقم 45جبته منين اخى عبد العزيز هل تقصد هكذا Sub trs_invoice() Application.ScreenUpdating = False Dim LR As Long, LR1 As Long Dim WS As Worksheet Dim WS1 As Worksheet Set WS = Worksheets("فاتورة بيع") Set WS1 = Worksheets("ترحيل الفاتورة") LR1 = WS1.Range("c55555").End(xlUp).Row + 1 Dim FR For R = 3 To LR1 If WS1.Cells(R, 3) = WS.Range("f6") Then MsgBox "This invoice already exist, No shift will done": Exit Sub Next For FR = 11 To 27 If WS.Cells(FR, 2) = "" Then GoTo 7 WS1.Cells(LR1, 2) = WS.Range("F7").Value WS1.Cells(LR1, 3) = WS.Range("F6").Value WS1.Cells(LR1, 4) = WS.Range("C6").Value WS1.Cells(LR1, 5) = WS.Range("C7").Value WS.Range("B" & FR & ":H" & FR).Copy WS.Range("h" & FR & ":H" & FR).Copy WS1.Range("F" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False WS.Range("g" & FR & ":g" & FR).Copy WS1.Range("g" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False WS.Range("f" & FR & ":f" & FR).Copy WS1.Range("h" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False WS.Range("e" & FR & ":e" & FR).Copy WS1.Range("i" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False WS.Range("d" & FR & ":d" & FR).Copy WS1.Range("j" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False WS.Range("c" & FR & ":c" & FR).Copy WS1.Range("k" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False WS.Range("b" & FR & ":b" & FR).Copy WS1.Range("l" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False LR1 = LR1 + 1 7 Next FR Application.CutCopyMode = False WS.Select Application.ScreenUpdating = True End Sub تقبل تحياتى

الأخ الكريم أبو جنى اعتقدت أن المشكلة قد تم حلها عموماً جرب الملف المرفق التالي .. وإذا قابلتك أي مشكلة قم بالضغط على كلمة Debug وحدد السطر الملون بالأصفر والذي تظهر به المشكلة كما يرجى ذكر إصدار الأوفيس الذي تعمل عليه الملف المرفق مجرب ويعمل بشكل جيد ولا يوجد أي مشاكل ..أنا أعمل على أوفيس 2013 تقبل تحياتي newPDF2.rar

اخي تم عمل تعديل بسيط لتسهيل الموضوع ارجو انه لايؤثر علي العمل جرب المرفق واخبرتي النتيجة تحياتي YouQu.rar

اخي ياسر اعلم بأنك تريد الايضاح للاخوة فأنت من أساتذة هذا المنتدى وارجوا ان يفي بذلك الشرح المرفق ادناة الفكرة تقوم على انه في حالة وضع بيانات عملاء مثلا او موردين ......الخ ووضع تاريخ زيارة او استحقاق في تاريخ معين في شيت "Machines_Card" وقمنا بتحديد المدة المدة الواجب التنبية عليه والموجودة في الخلية "A1" في شيت "Main" فسيتم حساب عدد التنبيهات وفقا لععد الحالات المطابقة واظهارها في منطقة الجرس وبالضغط على ايقونة الجرس سيتم عمل لنسخ لتلك الحالات لشيت "Notifications" حتى يسهل طباعتها او متابعتها او ايا" كان المراد منها ارجوا ان اكون وفقت وفقنا الله واياكم

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

اخي العزيز حقل متاح فينموذج تفاصيل الدورات لا يقوم بشي اساسا اسم النموذج تفاصيل اي للاطلاع فقط اما تاثير هذا الحقل فيظهر عندما اريد تسجيل طلاب في دورة فعند اختيار دورة معينة وصادف انها غير متاحة سوف يخبرني البرنامج بذلك وهذا الامر موجود في نموذج تسجيل الطلاب في الدورات فقط اما متى تكون الدورة متاحة ام لا فهذا يعتمد على مدخل البيانات وعلى السرعة في تحديث البيانات اقصد بيانات الدورات اولا باول لذا اكدت لك انه يجب تحديد هذا الحقل عند انشاء دورة جديدة ليؤدي الغرض منه

اخي الفاضل هذه رسالة خطأ في سطرين من الاكواد تم ايقافهما لم يهمني البحث في معناهما بقدر رفع الملف لك مرة اخري حفاظا عليه ولتطمأن عليه تحياتي PO2.rar عذرا اخي اسامه لم اري ردك الا بعد ان رفعت مشاركتي

السّلام عليكم و رحمة الله و بركاته جزاك الله خيرًا و زادها بميزان حسناتك .. كل حرف تكتبه بألف حسنة إن شاء الله .. مجهود كبير تقوم به ..فلترة و تجميع و حفظ .. بارك الله فيك يا غالي يا أبا يوسف وافر احتراماتي

ممتاز ورائع حقاً أخي الغالي جعفر الآن .. بدأ الفورم يعمل .. عند الشروع في العمل والضغط على زر Start تظهر الضور المقطعة بشكل طبيعي ولكن عند بداية سحب الصور تظهر الصور بخلفية بيضاء وتختفي الصورة ...

مشكورين على الردود أستادي الفاضل ياسر بدل ال olepro32.ddl ب OleAut32.dll لتصبح كالتالي : Private Declare Function OleCreatePictureIndirect Lib "OleAut32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

أخي الحبيب جعفر يبدو أنني سأكون مصدر إزعاج لك .. قمت بالتعديل على API Declarations لكي يعمل الكود على الويندوز 64 بت وعند التنفيذ ظهرت لي رسالة File not found : olepro32.dll أعمل على ويندوز 10 64 بت ...

تفضل اخي العزيز ملاحظة عند اضافة دورة جديدة يجب عدم ترك حقل متاح\غير متاح فارغ بالاضافة الى اني جعاته حقل مطلوب اي عدم تركه فارغ Dawrat6.rar

السلام عليكم =========== حرصأ على وقت الاعضاء وعدم تكرار المواصيع وسهولة البحث هذا الموضوع خاص بادراج الصور فى الخلايا وما شابهها من مواضيع ساجعل الموضوع مثبت ومفتوح للردود وذلك لمشاركة الاخوة بروابط المواضيع المشابهة سيكون الموضوع مثبت ومفتوح للردود حتى يوم 10/10/2011 وبعد ستحذف الردود وينقل الموضوع الى الدليل جمعة مباركة على الجميع وكل عام وانتم بخير الموضوع رقم (1) عرض الصور في الخلايا حسب الاسماء http://www.officena....=1 =========================================== الموضوع رقم (2) ادراج صورة فى خلية http://www.officena....A9&fromsearch=1 =========================================== الموضوع رقم (3) طلب بخصوص ادراج صورة عن طريق الفورم وحفظها http://www.officena....A9&fromsearch=1 ============================================ الموضوع رقم (4) جلب صورة من ملف بدلالة الرقم الوظيفي http://www.officena....A9&fromsearch=1 ============================================= الموضوع رقم (5) إدراج الصـورة فـى تعليق الخليـة أتـومـاتيكيـا مع التحكم بحجمها http://www.officena....A9&fromsearch=1 ============================================= الموضوع رقم (6) دالـة ( VLOOK_Pic1 ) لعـرض الصـور من أى نـوع و أى حجـم http://www.officena....=1 ============================================= الموضوع رقم (7) ظهور الصوره بالنسبه- للمحترفين http://www.officena....showtopic=38962 ============================================= الموضوع رقم (8) كيفية حفظ الصورة داخل ورقة اكسيل http://www.officena....showtopic=28547 ============================================= الموضوع رقم (9) التقاط صورة للتحديد خلايا او صوره او اي شي http://www.officena.net/ib/index.php?showtopic=37813

شكرا لك أخي سليم على هذا الحل وهذا حل آخر بالأكواد لا يلزم منه الحفاظ على ترتيب الأسماء طريقة الاستخدام 1/ ادخل على شيت بطاقة موظف 2/ في الخلية B1 اكتب بعض الأحرف للاسم المراد البحث عنه (أو الاسم كله كما تريد) ثم اضغط زر البحث مثال : إذا كتبت (علي) يسظهر لك كل الأسماء التي فليها (علي أو عليان أو علياء أو عليوي .....) 3/ في قائمة الأسماء الموجودة في العمود D أنقر نقرا مزدوجا (مرتين) على أي أسم من الأسماء الموجودة ولاحظ النتيجة تحياتي البحث في شيت داتا عن اسم الموظف1.rar

مرسل مثال لكشف الاسماء المراد ترحيلهم الى الاستبانة وشكرا لكم على المتابعة الكشف.rar

البرنامج عندي يعمل بصورة صحيحه سواء نسخه 2003 او نسخه 2007 واليك صورة البرنامج وارجو اذا كانت المشكله هذة قد واجهت احد اخر ان يخبرنا حتى يمكن الوصول الى السبب واعتقد اخى العزيز ان هناك مشكله عند ك فى الجهاز حاول تنزيل اوفيس 2007 حيث يظهر من الصورة لديك اوفيس 2003 وربما فى مشكله عند فيه وعلى العموم شاهد هذة الصورة التى يجب ان يكون عليها البرنامج مع العلم بانني اختبرته على اكثر من جهاز ويعمل بشكل طبيعي صورة البرنامج.rar

الاخ الفاضل / amfouad555 تحديد الصلاحيات لا يتم من صفحه mydate ولكن من خلال نموذج الصلاحيات الذى يتم الوصول اليه من شاشه الدخول عندما تدخل باسم الدعم الفنى وبعد كتابه كلمه السر وقبل دخولك للبرنامج اضغط على زر تحديد الصلاحيات فيفتح لك نموذج تختار من اعلى القائمه اسم المستخدم فتظهر لك صلاحياته بالاسفل على كل صفحه ويوجد فى الاسفل اربع اختيارات تساعدك فى ملىء النموذج باحد الصلاحيات لجميع الصفحات ثم بعد ذلك تختار من الكومبوبوكس امام اى صفحه تريد تغيير صلاحيتها ومن ثم تقوم بالحفظ فيتم الحفظ مباشرة فى صفحه mydate واكرر ان صفحه mydate لا يتم التعامل معها بشكل مباشر الا فى شىء واحد فقط اذا اردت تغيير اسم مستخدم موجود فعلا وما دون ذلك يتم من خلال النماذج سواء بتغير الصلاحيات او اضافه مستخدمين او تغيير كلمه السر و التعامل من خلال النماذج اسهل مما تتخيل ولكن فقط ستتمكن من هذة النماذج مع المستخدم الدعم الفنى وكتابه كلمه السر الصحيحه له وهى 111 واتمنى اكون قد اوضحت الفكرة واى استفاسر ان شاء الله حاضرين

من أعمال الأستاذ خبور Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim CC As Integer, C As Integer Dim sR As String Dim MyRng As Range Set MyRng = Range("n8:Aw78") If Not Intersect(Target, MyRng.Cells) Is Nothing Then Application.EnableEvents = False CC = MyRng.Column - 1 C = Target.Column - CC sR = MyRng.Columns(C).Address If Application.CountIf(Range(sR), Target.Value) > 1 Then If MsgBox(" this value was enter" & vbLf & vbLf & "Do you want to continue? ", 16 + vbYesNo + 524288 + 1048576, "Note") = vbNo Then Target.ClearContents End If End If Kh_ColorIndex Range(sR) Application.EnableEvents = True End If On Error GoTo 0 End Sub

جزاك الله كل خير للاستجابة السريعة واقدرها لك تم ارفاق ملف Desktop.rar