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

بعد اذن الاستاذ احمدزمان تفضل اخ حمود الحارثي ATTENDANCE ALL STAF.xls

للعلم بداية ولكن ليس لاحواله نهاية ... فوددت مشاركتكم بهذا سعيا لعموم الفائدة هذا تصور عن احوال أزرار التنقل باختصار شديد .... Private Sub cmdLast_Click() Navigate acLast End Sub Private Sub cmdNew_Click() Navigate acNewRec End Sub Private Sub cmdNext_Click() Navigate acNext End Sub Private Sub cmdFirst_Click() Navigate acFirst End Sub Private Sub cmdPrevious_Click() Navigate acPrevious End Sub Private Sub Navigate(intWhere As Integer) On Error GoTo CannotGo DoCmd.GoToRecord , "", intWhere Exit Sub CannotGo: Beep End Sub

تفضل التطبيق و الله من وراء القصد شكرا Na_NavButton.rar

تسهيلا للعمل تم استبعاد أيام العطلات الأسبوعية من كشف الغياب وتم تحويل الملف لصيغة تقبل التعامل مع الأكواد حيث أنه يصعب عمل المطلوب بدون تدخل جراحي (أقصد كود vba ) فقط يلزمك الضغط على زر الغياب لتسجيل الغياب من شيت data إلى الكشف مع الانتباه إلى المتغيرات في الكود أما بالنسبة للتأخير والاضافي والانصراف المبكر فالمطلوب غير واضح هل يكتب حرف من الحروف في كل حالة أم يكتب محتوى الخلية في شيت البيانات؟ نفعنا الله وإياكم بما علمنا وعلمنا ما ينفعنا a1mas_Time Sheet.rar

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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته أسعد الله أوقاتكم أحبتي في الله اليوم هديتي لإدارة ومشرفي وأعضاء وزوار منتدانا الرائع هدية كبيرة الحجم قليلا (فأنا معروف بسلسلة ما خف وزنه وغلا ثمنه "الماس" ) برنامج أوفيس 365 وهو تحديث أوفيس 2016 بأحدث إصدار 16.0.8431.2110 بصيغة img وهي مثل iso تحميل مباشر من موقع ميكروسوفت (يعني أصلية ومش ملعوب فيها) ويوجد روابط اللغتين اللغة العربية O365ProPlusRetail_ar.img واللغة الإنجليزية O365ProPlusRetail_en.img حجم الاسطوانة الوهمية img حوالي 2.5 جيجابايت والآن مع روابط التحميل اللغة الإنجليزية http://swiftation.com/9612849/mso365en2018 اللغة العربية http://swiftation.com/9612849/mso365ar2018 وفي الأخير لو بخل بهذه المعلومة غيرك ما وصلت إليك فلا تبخل على غيرك بما عرفت وشارك هذه الصفحة قدر استطاعتك فلا خير في كاتم علم ولا ينقصني سوى دعاؤكم لي بالخير في الدنيا والآخرة

السلام عليكم ورحمة الله وبركاته الإخوة الأفاضل ,, حفظكم الله لدي ملف يحتوي على معلومات (50 سيارة نقل) يتم تحديث بيانات هذا الملف يوميا من ملف أخر بإستخدام دالة vlookup عن طريق رقم السيارة أريد أن أعمل يوزر فورم بجيث أقوم أنا بتحديد مسار الملف ويقوم الفورم بجلب البيانات بإستخدام vlookup وتحديث الشيت. أنا بحثت في المنتدى ولم أجد .. وإذا هناك شرح في هذا المنتدى أفيدوني وقد أرفقت لكم الملف للمساعدة وبارك الله فيكم جميعا excel.rar

السلام عليكم ورحمة الله استخدم هذا الكود Sub CallData() Dim ws As Worksheet, Sh As Worksheet Dim Arr As Variant, Temp As Variant Dim i As Long, j As Long, p As Long, x As Long Dim List As String, DataList As String Set ws = Sheets("BD") Set Sh = Sheets("نتيجة") List = Sh.Range("D1").Value DataList = Sh.Range("E1").Value If DataList = "" Then Exit Sub Sh.Range("A4:G" & Sh.Range("B" & Rows.Count).End(xlUp).Row + 3).ClearContents x = WorksheetFunction.Match(List, ws.Range("A1:G1"), 0) Arr = ws.Range("A2:G" & ws.Range("C" & Rows.Count).End(xlUp).Row).Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, x) = DataList Then p = p + 1 For j = 1 To 7 Temp(p, j) = Arr(i, j) Next End If Next If p > 0 Then Sh.Range("A4").Resize(p, UBound(Temp, 2)).Value = Temp End Sub

السلام عليكم ورحمة الله وبركاته من الله علي بطريقة لعمل Tool bar او Ribbon Bar مثل البرامج الاحترافية وهي كالتالي وأسأل الله ان تفيد الجميع عمل Tab control في رأس انموذج ثم اضافة التبويبات حسب التصنيف الذي ترغب فيه مثلا تبويب للعملاء وتضيف اليه جميع الازرار الخاصة بالنماذج والتقارير ثم تبويب اخر للموردين وتضيف اليه كذلك ما تريد من ازرار ثم بعد الانتهاء من اضافة التبويبات المطلوبة تذهب الي خصائص الTab Control وتذهب الي خاصية Back style وتجعلها Transparent وبدلا من الازرار التقليدية يمكنك اضافة صورة واضافة امر لها عند النقر ولاضافة خاصية اخري يمكنك جعل المؤشر عند المرور علي الصورة ان يظهر شكل اليد لتكون افضل شكلا مرفق مثال ومدرج به موديول خاص بتغيير شكل المؤشر لشكل اليد عند المرور علي الصورة اي استفسار انا تحت امر الجميع مع خالص الشكر لاعضاء المنتدي المحترمين واسال الله ان ينفع بهذا العمل وان يجعله خالص لوجهه الكريم مرفق المثال Test.rar

تفضل If MsgBox("هل تريد حذف السجل", vbYesNo + vbCritical + vbMsgBoxRight + vbDefaultButton2, "تحذير") = vbNo Then Exit Sub Else DoCmd.SetWarnings False DoCmd.RunCommand acCmdDeleteRecord Refresh DoCmd.SetWarnings True End If لاتنسى التقيم بارك الله فيك بالتوفيق ،،،

تم وضع دالة اجمالي الصفحة السابقة اجمالي الصفحة الحالية اجمالي جميع الصفحات بالاضافة الى التفقيط بدمج الوحدة النمطية التي افضلها اتمنى ان يكون هذا هو طلبك دعوتكم sum.rar

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

الله يجزاك كل خير

موجود ممكن ترسل المقطع نطبقها ونعيدها لك

ربما يكون الحل غياب.xlsx

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

المطلوب غير واضح

أعتذر إليك أستاذ أدام.. الصحيح أن العبارة تكتب في محرر الشفرة بهذه الطريقة DateFiled.Format="[blue]yyyy/mm/dd" ولكنها في الجدول تكتب مباشرة بدون علامة التنصيص.. كما في المرفق NA Colour All.accdb

اخي الكريم كاسر طبعاً لاتوجد مشكلة لو استخدمت ذلك الكود في كل النماذج لكن لماذا نستخدمه في حين اننا يمكننا ان نستخدم الكود المبسط قلت لي انك واجهت خطأ في عدم تعرف البرنامج على قيمة x الخطا هو انك لم تقم بتعريف المتغير x كمتغير عام في البرنامج الحل هو انشاء وحدة نمطية وسمها variables وقم باضافة التالي Public x as Boolean وان شاء الله يعمل معك بصورة سليمة هنا قمنا بتعريف المتغير x كمتغير عام من نوع Boolean ليكون اما true او false .. هذا معناه انك لو وضعت x = true في النموذج رقم 1 ففي النموذج رقم 10 ستكون قيمة x = true ايضاً .. هذا مايسمى بالمتغير العام .. كما يمكنك اضافة اي متغيرات عامة اخرى في نفس الوحدة النمطية السابقة يعني مثلاً اريد اضافة متغير y قيمته 1 نأتي الى الوحدة النمطية السابقة ونضع Const y = 1 وهكذا تحياتي

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

حسب فهمي للطرح هل هذا هو المطلوب ؟ مثال2.rar

السلام عليكم لقد جربته على جهازين مختلفين و يعمل جيدا ، و الجهازين بهما اوفيس 2016 ربما بعد الكود غير منوافق مع النسخة لديك افتح محرر الاكود و اختار Debug compile VBA Project و أخبرني اذا توقف لكود عند سطر معين او اعطي رسالة مختلفة

اخي الكريم يكفي ان تضع الامر Beep عندما لايتم العثور على المادة ضعه قبل رسالة msgbox التي تخبر المستخدم بعدم العثور على المادة تحياتي

اخي الكريم كاسر الامور لاتتم بهذا الشكل الذي تفضلت به ..ففي عالم البرمجة الامور تتم على نحو مغاير لما تقوله للآخرين .. دعنا نحلل المسألة بشكل بسيط في البداية يجب ان نعرف ان نموذج التسجيل وظيفته المحددة هي قراءة رقم التسجيل الذي يدخله المستخدم في مربع النص ويقارنها مع رقم الهارد مثلاً ومن ثم تخزين رقم التسجيل في الجدول ... هنا نلاحظ ان نموذج التسجيل لايقرأ القيمة التي يخزنها في الجدول لان وظيفته هي قراءة مايدخله المستخدم فقط ويقارنها بقيمة الهارد لكي يتم قراءة رقم التسجيل المخزن في الجدول في كل مرة يقوم المستخدم بفتح البرنامج فهنا نضع في حدث عند الفتح للنموذج الرئيسي كود فحص فإذا وجد ان القيمة المخزنة في الجدول صحيحة يقوم بفتح النموذج والا فسوف يظهر رسالة للمستخدم بعدم صحة البيانات ومن ثم يفتح له نموذج التسجيل طبعاً برمجياً نحن لاتحتاج الى التأكد من رقم التسجيل في كل مرة يتم فتح احدى تلك النماذج بل كل ماعليك فعله هو وضع متغير عام من نوع Boolean يعطيك true او false فقط مع استخدام عبارة if الشرطية كيف يتم ذلك؟ الجواب لنأتي الى بداية العملية .. عندما يقوم المستخدم بادخال رقم التسجيل الصحيح في نموذج التسجيل فسوف تظهر له رسالة بنجاح عملية التسجيل .. بعد تلك الرسالة نضع متغير عام (public) وليكن x = true اما عندما يكون رقم التسجيل خطأ فسوف تظهر له رسالة فشل التسجيل لان الرقم غير صحيح .. بعد تلك الرسالة نضع نفس المتغير السابق يساوي x = false في كلتا الحالتين سوف يتم تخزين رقم التسجيل الذي ادخله المستخدم في الجدول سواء كان صح ام خطأ لايهم لاننا سوف نتأكد من صحته عند فتح النموذج الرئيسي الآن نأتي على النموذج الرئيسي وضع في حدث عند الفتح كود التحقق من القيمة المخزنة في الجدول كالتالي x = false if Nz(Dlookup("[serial]", "tblsn"),0) = HardSerial() then x = true else: x = false if x = false msgbox "رقم تسجيل البرنامج غير صحيح" docmd.openform "reg" DoCmd.close acForm, Me.Name end if ومن ثم نأتي للنموذج الثاني وضع الكود التالي في حدث عند الفتح if x = false msgbox "رقم تسجيل البرنامج غير صحيح" docmd.openform "register" DoCmd.close acForm, Me.Name end if وكذلك لبقية النماذج نضع لها هذا الكود في حدث عند الفتح if x = false msgbox "رقم تسجيل البرنامج غير صحيح" docmd.openform "register" DoCmd.close acForm, Me.Name end if نلاحظ ان اعتمادنا على قيمة x التي لو كانت true فسوف يتم فتح النموذج بشكل طبيعي ولو كانت false فسوف يغلق النموذج ويفتح نموذج التسجيل قيمة x تخزن في الذاكرة عند فتح النموذج الرئيسي لان الكود في النموذج الرئيسي سوف يفحص رقم التسجيل المخزن في الجدول ويطابقه برقم الهارد فاذا وجدها قيمة مطابقة فسوف يخزن x = true والا فان x = false هذا كل مافي الامر .. اتمنى ان يكون شرحي واضح تحياتي

ده الشغل واللا بلاش .. يحفظك ربنا استاذ محمد صالح

ادراج رزنامة شهرية لسنة معينة و شهر معين (باختيارك) بدون يوم او يومين تحددهما بنفسك و اذا لم تحدد الايام (بمسح الخلايا المناسبة) يتم ادراج كامل الشهر Sub Give_date_without_same_days() With CommandButton1 .Left = 469: .Top = 18.5: .Width = 154.5 End With If Not IsNumeric([a2]) Or Not IsNumeric([b2]) _ Or [b2] < 1 Or [b2] > 12 _ Or IsEmpty([a2]) Or IsEmpty([b2]) Then MsgBox "أدخل أرقاماً صحيحة في الخلايا " & Chr(10) & "$ِِِA$2 and $B$2 " & Chr(10) _ & "وأعد المحاولة", vbOKOnly + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "!...ٍSalim" Range("c4:Ag5").ClearContents Range("c4:Ag5").Borders.LineStyle = 0 GoTo Exit_Me End If With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlManual End With Dim Array_Days(), My_Days_Arabic() Dim Arab_Day(), My_Date_For_Print() Dim Array_Numbers() Dim t As Date, i%, k%, m%, x%, last_col% Dim y$ '============================== Array_Days = Array("sun", "mon", "tue", "wed", "thu", "fri", "sat") Arab_Day = Array("الأحد", "الإثنين", "الثلاثاء", "الأربعاء", "الخميس", "الجمعة", "السّبت") Array_Numbers = Array(1, 2, 3, 4, 5, 6, 7) last_col = Cells(5, Columns.Count).End(1).Column Range("c4").Resize(2, last_col).ClearContents Range("c4").Resize(2, last_col).Borders.LineStyle = 0 '================================= [a2] = Int([a2]): [b2] = Int([b2]) t = DateSerial([a2], [b2], 1) x = Day(Application.EoMonth(t, 0)) k = 1 For i = 1 To x y = Application.Index(Arab_Day, Application.Match(Weekday(t), Array_Numbers, 0)) If Trim(y) = Trim([d2].Value) Or _ Trim(y) = Trim([e2].Value) Then GoTo 2 ReDim Preserve My_Days_Arabic(1 To k): My_Days_Arabic(k) = y ReDim Preserve My_Date_For_Print(1 To k): My_Date_For_Print(k) = t k = k + 1 ' End If 2: t = t + 1 Next Range("C4").Resize(1, UBound(My_Days_Arabic)) = My_Days_Arabic Range("C5").Resize(1, UBound(My_Date_For_Print)) = My_Date_For_Print Range("C4").Resize(2, UBound(My_Days_Arabic)).Borders.LineStyle = 1 ActiveSheet.PageSetup.PrintArea = "" ActiveSheet.PageSetup.PrintArea = Range("a1").Resize(6, UBound(My_Days_Arabic) + 2).Address Exit_Me: Erase Array_Days: Erase Arab_Day: Erase Array_Numbers With Application .ScreenUpdating = True .Calculation = xlAutomatic .EnableEvents = True End With End Sub Private Sub CommandButton1_Click() Give_date_without_same_days End Sub Private Sub Worksheet_Activate() With CommandButton1 .Left = 469: .Top = 18.5: .Width = 154.5 End With End Sub الكود موجود ضمن الملف Date_sans_deux_jours.xlsm

الماكرو بعد التعديل ليصدر اول تسعة سجلات للتجربة تم ايضا محاولة تثبيت ترميز اللغة العربية و اختيار الثلاثة حقول التي تريد الاسم و هاتف المنزل و المحمول Sub Create_VCF() Dim iRow, FileNum For iRow = 2 To 10 FileNum = FreeFile CNAMe = ActiveSheet.Cells(iRow, 1) MTel = ActiveSheet.Cells(iRow, 2) HTel = ActiveSheet.Cells(iRow, 3) OutFilePath = ThisWorkbook.Path & "\" & CNAMe & ".VCF" Open OutFilePath For Output As FileNum Print #FileNum, "BEGIN:VCARD" Print #FileNum, "VERSION:2.1" Print #FileNum, "N;LANGUAGE=en-us;CHARSET=windows-1256:" & CNAMe Print #FileNum, "FN;CHARSET=windows-1256:" & CNAMe Print #FileNum, "TEL;HOME;VOICE:" & HTel Print #FileNum, "TEL;CELL;VOICE:" & MTel Print #FileNum, "END:VCARD" Close #FileNum Next iRow End Sub لتجربة الملف يمكنك تغيير عدد السجلات التى ترغب فى تصديرها بتغيير الرقم 10 الي الرقم الذي ترغب به ، حاليا اختيار الرقم 10 يصدر اول تسع سجلات (الي الصف العاشر فى الملف) ايضا يمكنك تعديل البداية بدلا من 2 التي تمثل السطر الثاني الي اي رقم ترغب به ليبدأ التصدير منه من لكن ليس رقم 1 لانه يحوي اسماء الحقول ExporttoCVF.xls

السلام عليكم ريما اكود وجدت الحل لموضوع اللغة العربية حيث تبين انه يمكن تحديد الترميز اثناء تكوين الملف و قد عرفت ذلك عندما سجلت احد العناوين بالعربية و صدرته وجدت ان الصيغة قد تغيرت لتشمل ترميز العربية CHARSET=windows-1256 و كان محتوي ملف ال CVF كالتالي عندما فتحته بمجرر النصوص BEGIN:VCARD VERSION:2.1 N;LANGUAGE=en-us;CHARSET=windows-1256:عرفة;محمد;طاهر FN;CHARSET=windows-1256:محمد طاهر عرفة TEL;HOME;VOICE:666666 TEL;CELL;VOICE:777777 END:VCARD و عليه يمكن تعديل كود الترميز ليحوي ترميز العربية ، و يبنى الملف بنفس الطريقة فى الملف اعلاه ساحاول باذن الله الآن و احاول ايضا تعديل الكود ليشمل الحقول التي تريدها كما فى السطور السابقة ، الاسم و رقم المنزل و رقم الهاتف

السلام عليكم ورحمة الله الخطأ في الدالة Vlookup أن البحث عن "قيمة البحث" تتم في العمود الأول من "نطاق البحث"... قمت باستبدال الدالة VLOOKUP بالدالتين INDEX و MATCH... بن علية حاجي 2018.xlsx

مرفق لكم ملف موضح فيه أكثر SHIFT1.xlsx

هي قاعدة Position في CSS وكيفية عملها سهل علي الكثير عند محاولة تصميم صفحة ويب. وعدم الدراية السليمة بالفرق بين Position:Static, Relative, Absolute, Fixed سيسبب لك الكثير من المتاعب والتخبط عند تصميم موقعك، ولكن سنوضح عنها الكثير. فقاعدة Position في CSS إن كنت تعرف أم لا فهي قاعدة لتحديد موقع العنصر في الصفحة، عن طريق التلاعب بإحداثيات العنصر في الصفحة Top, Right, Bottom and Left. وفي الحقيقة معظم عناصر الصفحة يجب أن تتبع التدفق الطبيعي للصفحة/الوثيقة Document،أي يتصرف كل عنصر بالشكل الذي صمم لأجله. ولكن يأتي دور Position عندم تريد عمل شيء أكثر تقدماً مثل الأنيميشن أو دفع عنصر خارج الإطار الطبيعي له دون التأثير على العناصر المحيطة مثلاً. ومما لا شك فيه أن هنا خصائص افتراضية لعناصر الصفحة. فمثلاً div فإن القيمة الإفتراضية للقاعدة display كذلك فإن القيمة الإفتراضية للقاعدة position لجميع العناصر هي static، وهي قيمة من ضمن مجموعة من القيم، حيث سنتحدث في السطور التالية عنها كل على حده وهي: Static Absolute Relative Fixed Inherit Sticky الخاصية Static وهي الوضع الإفتراضي لعناصر الصفحة/الوثيقة حيث تأخذ طريقة العرض والأسلوب والتأثير الإفترضي على العناصر المحيطة التي يُفترض أن تأخذه أثناء سريان بناء الوثيقة Document Flow. فإذا قمت بعمل اثنين div والذي يأخذ طريقة العرض block وموقعه الإفتراضي Static فمن الطبيعي أن يقع كل منهما أسفل الآخر وهذا هو السريان الطبيعي للوثيقة هي block بشكل افتراضي على عكس span التي هي inline. الخاصية Relative إذا كان الوضع الإفتراضي للعناصر هو المثول للتدفق الطبيعي للوثيقة، فإن هذه الخاصية تجبر العنصر على الخروج من هذا التدفق،ومع ذلك تتعامل معها العناصر المحيطة على أنها موجودة وتحتفظ بمساحتها. قد تسبب لك الخاصية Relative بعض الحيرة لأن هذه الخاصية في الحقيقة تعني أن العنصر “نسبي إلى نفسه أو بمعنى آخر إلى الموقع المفترض أن يوجد به”، وفي الحقيقة إن لم تقم بتغير قيم Top, Right, Bottom and Left سيكون تأثيرها مثل تأثير static ولكن على عكس Static يمكن تطبيق جميع الخصائص دون مشكلة. عند التحكم في قيم Top, Right, Bottom and Left يتم ترحيل العنصر عن موقعه دون أن يؤثر على العناصر المحيطة، على عكس تطبيق Margin والتي تدفع العناصر المحيطة بما يساوي قيمة الهامش Margin. الخاصية Absolute هي الأخرى تجبر العنصر على الخروج من التدفق الطبيعي للوثيقة ولكن على عكس Relative ليس له تأثير على العناصر التي تتبع التدفق الطبيعي للوثيقة ويأخذ موقعه المطلق (تتعامل معه عناصر الوثيقة كما لو كان غير موجوداً بها). والموقع المطلق Absolute في الحقيقة يتوقف على عدة عوامل: إذا قمت بتحديد الخاصية position:absolute فقط دون تحديد الإحداثيات (Top, Right, Bottom and Left) فإن القيمة الإفتراضية للإحداثيات تكون auto، وهذا يعني أن العنصر سيكون في الموقع الذي هو مفترض أن يكون به أثناء وجوده داخل التدفق الطبيعي للوثيقة. إذا قمت بتحديد الخاصية position:absolute مع تحديد أي من الإحداثيات (Top, Right, Bottom and Left) فسيحدث أحد أمرين: سيتم تحديد موقع العنصر المطلق بالنسبة لأول أب موقعه ليس static إذا لم يتم العثور على أب أو جد إلى أخر الترتيب الشجري يأخذ موقع غير static سيتم تحديد العنصر بالنسبة للوثيقة/الصفحة لنفرض مثلاً أن لديك إثنين div داخل بعضهما وأنت لم تقم بتغيير الـ Position، أي في الوضع الإفتراضي، فإن الوضع الطبيعي أن يكونا فوق بعضهما. ثم قمت بتغيير الموقع للـ div الداخلي (الإبن) إلى Absolute، ماذا تتوقع أن يحدث؟ إليك هذا السيناريو: هل تم تحديد الإحداثيات؟ إن كان لا يكون العنصر بالنسبة لموقعه الإفتراضي إن كان نعم؟ سيقوم الـ div الإبن بفحص الـ Position للـ div الأب فإن كان موقعه هو الإفتراضي Static (هذا ما افترضناه) فيقوم بتخطيه والنظر لما بعده وهكذا إلى أن يجد أحد الآباء يأخذ موقع غير static، فيقوم باتخاذه نقطة بداية. إن لم يجد نهائياً فيقوم بالضبط نسبة للوثيقة نفسها. الآن سنقوم بتجربة ضبط وضع الـ div الداخلي إلى absolute دون تغيير الأب أو تحديد إحداثيات، ولكن سنقوم بعمل هامش علوي للأب حتى نفرق بينه وبين الوثيقة

السلام عليكم لاستبدال تصدير اوراق العمل كلها ، بتصدير ملف واحد الي pdf استبدل السطرين التالليين ShFile = strPath & Left(wbk.Name, Len(wbk.Name) - 4) & Sheetcounter & "-" & wsh.Name ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ShFile _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False بما يلي ShFile = strPath & Left(wbk.Name, Len(wbk.Name) - 4) wbk.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ShFile و من الأفضل أن يتم نقله خارج اللوب الخاص بالشيتات. حتى لا يتكرر إنشاء و استبدال الملف. متبقي التعامل مع الملفات الموجودة فى المجلدات الفرعية و ربما بعد الانتهاء نضيف واجهة استخدام باذن الله ليصبح التطبيق اكثر سهولة و اعم فى الاستخدام

طلب الي احد الاصدقاء وضع كود لادراج رزنامة لسنة محددة وشهر محدد مع تمييز (يوم معيّن) من هذا الشهر فكان هذا الكود الذي ارجو ان يستفيد منه الاخرون قبل تنفيذ الكود الكود: تسمية الصفحة التي تريد العمل عليها بهذا الاسم "Salim_Calendar" اكتب في الخلية B1 رقم السنة في الخلية B2 رقم الشهر في الخلية G1 رقم اليوم المييز الكود Option Explicit Option Base 1 Sub My_Calandar() If ActiveSheet.Name <> "Salim_Calendar" Then Exit Sub Dim t As Date, i As Byte Dim Arab_day(), m% Dim EnG_day(), rows_count As Byte Dim col As Byte Dim r As Byte Dim search_day As Date rows_count = Range("b4").CurrentRegion.Rows.Count + 3 Range("b4:H" & rows_count).ClearContents Range("b5:h10").Interior.ColorIndex = 0 '''''''''''''''''''''''''Conditions for working'''''''''''''''''' If Not IsNumeric([b1]) Or Not IsNumeric([b2]) _ Or [b1] < 1 Or [b2] > 12 Or [b2] < 1 Then MsgBox "Type Valid Numbers in cell(B1) & cell(B2)": Exit Sub End If ''''''''''''''''''''''''' End of Conditions for working'''''''''''''''''' r = 5 t = DateSerial([b1], [b2], 1) '''''''''''''''''''''''''Conditions for Special Day'''''''''''''''''' If Not IsNumeric([g1]) Or [g1] > Day(Application.EoMonth(t, 0)) _ Or [g1] < 1 Then [g1] = 1 Else [g1] = Int([g1]) End If '''''''''''''''''''''''''End of Conditions Special Day'''''''''''''''''' search_day = DateSerial([b1], [b2], [g1]) Arab_day = Array("الأحد", "الإثنين", "الثلاثاء", _ "الأربعاء", "الخميس", "الجمعة", "السّبت") ' EnG_day = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat") Range("b4").Resize(, 7) = Arab_day m = Weekday(t) + 1 For i = 1 To 31 Cells(r, m) = t If t = search_day Then Cells(r, m).Interior.ColorIndex = 3 Else Cells(r, m).Interior.ColorIndex = 35 End If If Month(t + 1) > [b2] Then Exit For t = t + 1 m = m + 1 col = Cells(r, m).Column If col > 8 Then r = r + 1: m = 2 Next Erase Arab_day End Sub الملف مرفق My_Calendar.xlsm

للاختصار اكثر واكثر Option Explicit Option Base 1 Sub My_Calandar3() If ActiveSheet.Name <> "Salim_Calendar" Then Exit Sub Dim t As Date, Search_Day As Date Dim Arab_day(), EnG_day() Dim i As Byte, m As Byte, r As Byte, _ My_Max As Byte, rows_count As Byte rows_count = Range("b4").CurrentRegion.Rows.Count + 3 Range("b4:H" & rows_count).ClearContents Range("b5:h10").Interior.ColorIndex = 0 '''''''''''''''''''''''''Conditions for working'''''''''''''''''' If Not IsNumeric([b1]) Or Not IsNumeric([b2]) _ Or [b1] < 1 Or [b2] > 12 Or [b2] < 1 Then MsgBox "Type Valid Numbers in cell(B1) & cell(B2)": Exit Sub End If ''''''''''''''''''''''''' End of Conditions for working'''''''''''''''''' r = 5 t = DateSerial([b1], [b2], 1) My_Max = Day(Application.EoMonth(t, 0)) '''''''''''''''''''''''''Conditions for Special Day'''''''''''''''''' If Not IsNumeric([g1]) Or [g1] > Day(Application.EoMonth(t, 0)) _ Or [g1] < 1 Then [g1] = 1 Else [g1] = Int([g1]) End If '''''''''''''''''''''''''End of Conditions Special Day'''''''''''''''''' Search_Day = DateSerial([b1], [b2], [g1]) Arab_day = Array("الأحد", "الإثنين", "الثلاثاء", _ "الأربعاء", "الخميس", "الجمعة", "السّبت") ' EnG_day = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat") Range("b4").Resize(, 7) = Arab_day m = Weekday(t) + 1 For i = 1 To My_Max With Cells(r, m) .Value = t t = t + 1 m = m + 1 r = IIf(m > 8, r + 1, r) m = IIf(m > 8, 2, m) End With Next Range("b5:h9").SpecialCells(2).Interior.ColorIndex = 35 Range(Range("b5:h9").Find(Search_Day).Address).Interior.ColorIndex = 3 Erase Arab_day End Sub

ولإثراء الموضوع يمكن اختصار الأكواد قليلا إلى هذا Option Explicit Option Base 1 Sub My_Calandar() If ActiveSheet.Name <> "Salim_Calendar" Then Exit Sub Dim t As Date, i As Byte Dim Arab_day(), m% Dim EnG_day(), rows_count As Byte Dim col As Byte Dim r As Byte Dim search_day As Date rows_count = Range("b4").CurrentRegion.Rows.Count + 3 Range("b4:H" & rows_count).ClearContents Range("b5:h10").Interior.ColorIndex = 0 '''''''''''''''''''''''''Conditions for working'''''''''''''''''' If Not IsNumeric([b1]) Or Not IsNumeric([b2]) _ Or [b1] < 1 Or [b2] > 12 Or [b2] < 1 Then MsgBox "Type Valid Numbers in cell(B1) & cell(B2)": Exit Sub End If ''''''''''''''''''''''''' End of Conditions for working'''''''''''''''''' r = 5 '''''''''''''''''''''''''Conditions for Special Day'''''''''''''''''' If Not IsNumeric([g1]) Or [g1] > Day(Application.EoMonth(t, 0)) _ Or [g1] < 1 Then [g1] = 1 Else [g1] = Int([g1]) End If '''''''''''''''''''''''''End of Conditions Special Day'''''''''''''''''' search_day = DateSerial([b1], [b2], [g1]) Arab_day = Array("الأحد", "الإثنين", "الثلاثاء", _ "الأربعاء", "الخميس", "الجمعة", "السّبت") ' EnG_day = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat") Range("b4").Resize(, 7) = Arab_day For i = 1 To 31 t = DateSerial([b1], [b2], i) m = Weekday(t) + 1 Cells(r, m) = t Cells(r, m).Interior.ColorIndex = IIf(t = search_day, 3, 35) If Month(t + 1) > [b2] Then Exit For r = IIf(m + 1 > 8, r + 1, r) Next Erase Arab_day End Sub نفعنا الله وإياكم بما علمنا وعلمنا ما ينفعنا

أستاذي الكبير عبد الباري ممكن أقولك حاجة بس توعدني متزعلش .. أقول وأتوكل على الله .. حقيقة الأمر برامج الكنترول برنامج هاااااااام جدا جدا جدا ، وبالتالي يراعى فيه ان يكون حجمه خفيف شغله خفيف وعملي إلى حد كبير .. بالتالي أرجح دائما البعد عن كل ما يسبب ثقل للملف أو يجعل حجمه يكبر ..!!! أنا من فترة من حوالي سنيتن عملت برنامج للصف السادس طلب مني وكان البرنامج يسع التعامل مع أكثر من ألف مدرسة ومرن جدا وبصراحة أنا مش عارف عملته إزاي .. كله بعون الله وتوفيقه ، والبرنامج وفيه بيانات أكثر من 3000 طالب كان حجمه لا يتعدى 2 ميجا كان 1.3 تقريبا لا أتذكر صراحة ... المقصد من كلامي أن يكون البرنامج خفيف بقدر الإمكان .. لأن معظم اللي بيستخدموا البرامج دول شغالين في أجهزة المدارس (اللي هفا عليها الزمن) ، ويهمهم دايما المخرجات بقدر ما يهمهم شكل البرنامج ، ومش معنى كلامي إننا هنتغاضى عن الشكل ، هذا ليس مقصدي ، إنما هدفي الأول أن يكون البرنامج عملي من الدرجة الأولى ... نشوف ايه اللي الناس محتاجاه ، ونركز عليه ، وفقط وبالنسبة للناس اللي بتطلب كشوف المنادة وأرقام الجلوس وخلافه من أعمال الكنترول ، لما لا تكون منفصلة عن برنامج الكنترول الأصلي حتى لا نسبب ثقل للملف هذا رأيي الشخصي ( وأنتم لكم حرية التعامل مع البرامج بالشكل الذي يحلو لكم) فأنا لست حكرا على رأي أحد وأكرر هذا رأي شخصي (ولا يعني رأيي أني أفرض رأيي على أحد والعياذ بالله ..هذا مجرد رأي ، وقد أكون أخطأت فيه) والله من وراء القصد وهو يهدي السبيل .. أعتذر للإطالة .تقبلوا تحياتي

السلام عليكم تم التعديل: شاهد المرفق kh_Test_3.rar