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

السلام عليكم ورحمة الله تعالى وبركاته اولا وقبل اى شئ لم يتم ترتيب اسماء اساتذتى الكرام الذين تم كتابة اسمائهم لسبب محدد فالترتيب لا يعنى اى شئ اطلاقا فجميعهم النجوم اللامعة بمن نقتضى منهم فى هذا الصرح نهتدى ان شاء الله كما خو الحال مع باقى الاساتذة الذين لم اكتب اسمهم فلا يعنى ذلك اى شئ كلهم فى مرتبة واحدة وكلهم معلمينا الافاضل لا غنى لنا عنهم عذا فقط مجرد مثال اسرد اليكم الشـرح سريعا لفكرتى قبل البدء قد يتفق معى من يتفق ويختلف من يختلف لذلك انتظر ارائكم ان شاء الله فيشيد بهذه الطريقه من يشيد و يعترض من يعترض فنخرج ان شاء الله بأطيب النتائج هنا ان شاء الله اتعامل مع جدول باسم tblMainData والذى يختوى على الحقول A,B,C ونموذج باسم يضم الحقول على الترتيب txtA , txtB, txtC هذا الكود حتى اهئ النموذج للتعامل مع اختصار المفاتيح من الكيبورد Private Sub Form_Load() Me.KeyPreview = True End Sub وهذا الجزء حتى اسند القيم التى احتاج لنسخها الى متغيرات وكتبته هكذا ليسهل استدعاءه وقت الحاجة Private Sub SpecialCopy() 'الاعلان عن المتغيرات Dim VarFildeA As Variant Dim VarFildeB As Variant Dim VarFildeC As Variant 'اسناد قيم مربعات النص الى المتغيرات VarFildeA = txtA VarFildeB = txtB VarFildeC = txtC DoCmd.GoToRecord , , acNewRec 'سجل جديد 'نسخ قيم المتغيرات الى مربعات النص في السجل الجديد txtA = VarFildeA txtB = VarFildeB txtC = VarFildeC 'تفريغ المتغيرات VarFildeA = Empty VarFildeB = Empty VarFildeC = Empty End Sub وهذا الجزء لاسناذ القيم من المتغيرات الى مربعات النص للسجل الجديد وكتبته هكذا ليسهل استدعاءه وقت الحاجة Private Sub DoCopy() DoCmd.RefreshRecord If DCount("[ID]", "tblMainData") = 0 Then DoCmd.RefreshRecord Exit Sub ElseIf DCount("[ID]", "tblMainData") >= 1 Then If NewRecord Then DoCmd.GoToRecord , , acLast Call SpecialCopy Else Call SpecialCopy End If End If End Sub طبعا هنا اتأكد اولا ان كان هذا السجل الاول فى الجدول ام لا قبل ان تتم عملية اسناد القيم التى اريدها واهيرا استدعاء الكود من هلال زر امر لتنفيذ عملية نسه السجل الاأهير وقت الحاجة Private Sub BtnDuplicate_Click() Call DoCopy End Sub وهذا الجزء كما يقولون عنه الـ Hot Key استدعاء الكود من خلال زر من الكيبورد عن الضغط عليه Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 117 Then ' استبدل هذا الرقم برقم المفتاح بالاعلى كما يحلو لك Call DoCopy KeyCode = 0 Exit Sub End If End Sub تنويه ببعض الحيل ان اردنا نقوم بنسخ سجل محدد ان اردنا سجل بعينه تبعا لشرط او شروط محدده حسب ما تقتضى الحاجة واخيـــرا المرفق Duplicate Last Record.mdb

السلام عليكم 🙂 انا صادفت اكثر من 3 - 4 برامج ، المبرمج قافلها ، واصحاب العمل ما عارفين شو يعملون ، بعد ان تم عمل فورمات للكمبيوتر ، والمبرمج طالب المبلغ الفلاني لإعادة تنصيب البرنامج !! فرجاء ، رجاء ، اللي يريد ان يقفل برنامجه ، رجاء ان يضع برنامج او اي كود في برنامجه الحالي ، بحيث يقدر صاحب البرنامج ان يشتغل عليه من جديد ، وفي لابتوبات مافيها إلا البارتيشن C فقط . وهنا سؤال ، هل في اتفاق بينك المبرمج وبين صاحب البرنامج ، ان البرنامج لك ، او له !! فإذا مافي ، فمعناه ان البرنامج له ، وهو حر التصرف فيه !! جعفر

هذا ما يسمى الحذف الوهمي ، وقد تطرق لهذه الفكرة وعرضها في طيات صفحات هذا المنتدى الاستاذ ابو آدم وانا اميل لهذا والسبب : أن عمليات الالحاق ثم الحذف لا تغير من حجم قاعدة البيانات ،، فالبيانات كما هي لم تتغير وانما انتقلت من جدول الى اخر ايضا فإن بقاء البيانات في مكانها بعيدة عن عمليات الإلحاق والحذف اكثر أمنا .

وعليكم السلام طالما انك لم تقم برفع ملف وشرح المطلوب بكل دقة فكان عليك استخدام خاصية البحث في المنتدى تفضل هذه الروابط قد تفيدك https://www.officena.net/ib/topic/54033-برنامج-الشيكات-مع-التقارير-الاصدار-الثاني-ضاحي-الغريب/?tab=comments#comment-340520 https://www.officena.net/ib/topic/45958-كيفيه-طباعة-الشيك-من-ذلك-النموذج/?tab=comments#comment-272771 وهذا نموذج أيضا بسيط وهذا أيضا برنامج جاهز لإدارة الشيكات bank_cheque_software.xls cheques_management_برنامج_ادارة_الشيكات.rar

تحياتي استاذ جعفر ولكل المشاركين مررت مرة واحدة بنفس ماذكر أستاذ جعفر مع عميل منذ مايقرب من ٨ سنوات ومن بعدها .. بعد الإنتهاء من تصميم البرنامج بعطي له نسخه مغلقه ونسخه مفتوحة حتي اكون ريحت ضميري أن كامل حقوقه له ولكن ... يأتي لي بعض العملاء بعد مايلعبون في النسخ المفتوحة ويقولون لي انت سلمتها لنا هكذا بايظة ! مع اني لو يرجعون لي لتعديل اي شيء انفذه لهم ولكن هو حب استطلاع فقط لاغير

أحسنت بارك الله فيك استاذ محمد

اخى الكريم بالنسبة لموضوع التاريخ وتثبيته ,هذا كان طلبك من البداية ان يكون التاريخ واليوم مثبتات ولا يتغيران مهما حدث اى تغيير تفضل جدول سير قضايا.xlsm

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

بارك الله فيك اخى الكريم وجزاك الله كل خير -ولك بمثل ما دعوت لى وزيادة بالتأكيد لا يؤثر عمل القائمة المنسدلة على الكود ولكن لا اعرف ما هي المشكلة لديك بالضبط فالملف يعمل معى تمام كما ترى بالصورة جدول سير قضايا.xlsm

أحسنت أستاذ خلف كود ممتاز جعله الله في ميزان حسناتك وكل عام وانتم بخير

وعليكم السلام تفضل Book2.xlsx

احسنت أستاذ عادل عمل رائع بارك الله فيك

السلام عليكم هل هناك كود معين يمنع مستخدم البرنامج من نسخة ووضعه على كمبيوتر اخر ؟؟ طبعا عدا عن ربطه بالهارد ديسك وبكرت الشاشة لانه طريقة مملة لا بد من وجود كود معين بهذا الخصوص ننتظر ابداعاتكم

وانا وانت وجميع المسلمين :: عدلت لك المرفق كي يقوم بتعبئة الحقول في الجداول تحياتي

الله ينور عليك استاذنا / AlwaZeeR حليت مشكله كانت كبيره عليا وبصراحه فوق قدراتى لك الف شكر فرج الله همك واعطاك حتى ترضى كما فرجت همى اللهم امين

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

السلام عليكم احصائية الفصل الاول للصفين لاتنس الملاحظات السابقة في الرد السابق في انتظار الملاحظات احصائيةالفصل الدراسى الأول 2019.xls

جربتها اخي الطيب أبا جودي فتحت بشكل طبيعي ويمكن التعديل عليها وووو

استاذنا / @عبد اللطيف سلوم تمام التمام الله يفتح عليك ويجعله في ميزان حسناتك ويرحم والديك كل الاحترام والتقدير لكم

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

من فضلك حسب بياناتك لو ذهبت الى هذا المسار C:\Program Files (x86)\Microsoft Office\root\Office16 على جهاز الكمبويتر تبعك لوجدت ملفات الاوفيس هنا ومن ضمنها الملف MSACCESS.EXE وهذا ما يهمنى ممكن تتأكد وتبلغنى النتيجة من فضلك

🙂 لماذا لا تستخدم الاذونات؟؟

جزاكم الله خيرا على هذا الدرس المهم

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

وعليكم السلام ورحمة الله وبركاته طبعا فيه يا أستاذ عبد اللطيف كنت استخدم هذه الطريقة قبل اكثر من 15 عام الطريقة: عمل ملف ما بصيغة مثلا Dll ووضعه في السيستم او أي مكان في الجهاز بمعنى يتوه داخل الجهاز ولا يعرف مكانه الا صاحب البرنامج وعند فتح النموذج الرئيسي للبرنامج نستخدم امر اذا كان هذا الملف موجود في المكان الذي حددناه افتح البرنامج واذا لم يكن موجود اظهر مثلا رسالة تفيد بان البرنامج قد تم نقله الى جهاز اخر وسيتم اغلاقه 🙂

تم تم

جربت مثالك الاخير على نسخة 2010 وعمل الكود بامتياز انتبه ! ضع المؤشر في حقل accid في الاسفل في حقل جديد ثم انقر f6 المنتدى ملك الجميع ، والحكمة ضالة المؤمن فاعرض ما شئت أنى شئت .

بارك الله فيكم وزداكم علما

جدوال 13 / 14 / 15 مكررة 234 / 235 بدون تاريخ

وعليكم السلام 🙂 تقدر تستخدم حقل رقم: Double Decomal او حقل نص 🙂 جعفر

أخى الكريم تم عمل المطلوب ولكن ملفك مش عارف ليه ثقيل جدا وبه مشاكل كثيرة عليك بضبط الملف وتم عمل اجمالى صافى ساعات العمل للموظف في الخلية E1 نظام البصمة.xlsm

أصبر قليلا جارى تنفيذ طلبك جدول 12 مكرر

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

ملف ممتاز بارك الله فيك أستاذ عادل وزادك الله من فضله وكل عام وانتم بخير

تفضل اخى الكريم شهادات سادس2018-2019.xls

شكرا لك اخى الكريم خلف بارك الله فيك

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

بارك الله فيك أستاذ وجيه وجعله في ميزان حسناتك

شكرا لك استاذى مينا وجزاك الله كل خير

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

الف مبروك للأستاذ وجيه ترقية مستحقة ان شاء الله

السلام عليكم. بعد جهد كبير وسهر ليالي كثيرة, وكلها محاولات بائت بالفشل لربط الـ Visual Studio .NET وقراءة البيانات بالاكسس وكانت متمثلة بمكتبة dll او tlb للاسف كانت هنالك عوائق ومنها لكي يتم استخدام مكتبة من نوع tlb كان يجب اعطائها صلاحيات مسؤول لكي تتمكن من تسجيل هذه المكتبة في HKEY_CLASSES_ROOT في الريجستري. وتستخدمها على شكل References وفي حال استخدام مكتبة من نوع dll كان يتطلب استخدام دالة LoadLibraryA وهذه سيعتبرها الانتي فايروس كـ ملف مريب خصوصا لانها تقوم بتحميل المكتبة في الذاكرة وبدون توقيع رقمي..الخ اليوم قمت ببرمجة شيء مختلف ومميز عبارة عن تطبيق صغير بلغة NET. يتم تمرير البيانات من الاكسس لهذه التطبيق لكي يقوم بعدها الاكسس باقتناص المخرجات من التطبيق بواسطة الي remote shell ثم عرضها في الاكسس مرة اخرى وكان التطبيق على تحويل التاريخ الميلادي الى هجري لكن هذه المرة بصورة ادق وافضل. كما نعرف جميعنا ان التاريخ الهجري يكون غير مضبوط زيادة يوم او يومين او نقصان يوم او يومين او لا يوجد زيادة او نقصان لذلك قمت بوضع ComboBox لهذا الأمر.. اكتب التاريخ الميلادي في الحقل الاول ثم اكتب فارق الايام ان وجدت زيادة او نقصان او اتركها صفر كما هي او لم يوجد تغيير السورس كود التطبيق بلغة NET. لمن يريده. Module SEMO_Pa3x '-------------------------------------------------------- 'c0ded bY : SEMO.Pa3x 'skype : security.najaf 'facebook : https://www.facebook.com/Nisr.Aln3jaf 'gmail : isec2090@gmail.com 'last edit : 26/4/2019 '-------------------------------------------------------- Sub Main() For Each arg As String In My.Application.CommandLineArgs If arg.StartsWith("/SEMO/") Then Dim rep As String Dim splt() As String rep = arg.Replace("/SEMO/", "") splt = Split(rep, ",") Dim GET_date, GET_args As String GET_date = splt(0) GET_args = splt(1) Dim ConvertToDate As DateTime ConvertToDate = DateTime.Parse(GET_date) DateFormating(ConvertToDate.AddDays(GET_args)) DateConvert(ConvertToDate.AddDays(GET_args)) Console.WriteLine(ArabicWeekdayString(Weekday(GET_date)) & "," & LongDateString) End If Next End Sub Public LongDateString As String = String.Empty '#Region " DateConverter (dateValue As String) As String " #Region " DateConverter (dateValue As String) As String " Public Function DateConvert(ByVal dateValue As String) As String LongDateString = "" ' الاحتفاظ بالإعدادت الحالية Dim currentCulture As Globalization.CultureInfo = Threading.Thread.CurrentThread.CurrentCulture Dim con As String = "" If DateFormating(dateValue) <> "" Then dateValue = DateFormating(dateValue) '---------------------------------- Dim y As String = IIf(dateValue <> "", dateValue.Split("/")(2), "") Dim mmm() As String If y > "1300" And y < "1451" Then con = GetGregorianDate(dateValue) mmm = Split(GetGregorianDate(dateValue), "/") LongDateString = ArabicWeekdayString(Weekday(GetGregorianDate(dateValue))) & " " & mmm(0) & " " & GregorianMonthString(Val(mmm(1))) & ", " & mmm(2) End If If y > "1883" And y < "2029" Then con = GetHijriDate(dateValue) mmm = Split(con, "/") LongDateString = mmm(0) & "," & HiriMonthString(Val(mmm(1))) & "," & mmm(2) & "H" End If End If ' إستعادة الإعدادت Threading.Thread.CurrentThread.CurrentCulture = currentCulture Return con End Function #End Region #Region " GetHijriDate(GregorianDate As String) As String " Private Function GetHijriDate(ByVal GregorianDate As String) As String Try Threading.Thread.CurrentThread.CurrentCulture = New Globalization.CultureInfo("ar-eg") Dim hijriDate As String = String.Empty 'Start Date is 10-31-1883 Dim DaysPan As Integer = DateDiff(DateInterval.Day, New System.DateTime(1883, 10, 31), CDate(GregorianDate)) + 1 Dim i As Integer = 0 Do While (DaysPan > 29 + Val(UmmUlquraHijriMonths.Chars(i))) DaysPan = DaysPan - 29 - Val(UmmUlquraHijriMonths.Chars(i)) i = i + 1 Loop hijriDate = Format$(DaysPan, "00") + "/" + Format((i Mod 12) + 1, "00") + "/" + CStr(1301 + (i \ 12)) Return hijriDate Catch ex As Exception ' MessageBox.Show("تأكد من التاريخ الميلادي.", "خطأ في التاريخ الميلادي", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign Or MessageBoxOptions.RtlReading) Return Nothing End Try End Function #End Region #Region " GetGregorianDate(HijriDate As String) As Date " Private Function GetGregorianDate(ByVal HijriDate As String) As String Try Threading.Thread.CurrentThread.CurrentCulture = New Globalization.CultureInfo("ar-eg") Dim gregorianDate As String = String.Empty Dim MonthsPan As Integer MonthsPan = (12 * (CInt(Mid(HijriDate, 7, 4)) - 1301)) + CInt(Mid(HijriDate, 4, 2)) Dim TempDaysPan As Integer Dim i As Integer For i = 0 To MonthsPan - 2 TempDaysPan = TempDaysPan + 29 + Val(UmmUlquraHijriMonths.Chars(i)) Next i If CInt(Mid(HijriDate, 1, 2)) > 29 + Val(UmmUlquraHijriMonths.Chars(i)) Then ' MessageBox.Show("رقم اليوم لهذا الشهر يجب أن لا يتجاوز 29", "خطأ اليوم الشهري للتاريخ الهجري", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign Or MessageBoxOptions.RtlReading) Return Nothing Else TempDaysPan = TempDaysPan + CInt(Mid(HijriDate, 1, 2)) End If 'Start Date is 10-31-1883 gregorianDate = CStr(DateAdd(DateInterval.Day, TempDaysPan - 1, New System.DateTime(1883, 10, 31))) Return gregorianDate Catch ex As Exception ' MessageBox.Show("تأكد من التاريخ الهجري.", "خطأ في التاريخ الهجري", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign Or MessageBoxOptions.RtlReading) Return Nothing End Try End Function #End Region #Region " UmmUlquraHijriMonths " 'UmmUlquraHijriMonths Private Function UmmUlquraHijriMonths() As String Dim HijriMonthSequence As String = "" 'Create the Months data from 1301H to 1450H - (150years) HijriMonthSequence += "111010010011" 'Year 1301H HijriMonthSequence += "011101001001" 'Year 1302H HijriMonthSequence += "011101100100" 'Year 1303H HijriMonthSequence += "101101101010" 'Year 1304H HijriMonthSequence += "010101110101" 'Year 1305H HijriMonthSequence += "010010110110" 'Year 1306H HijriMonthSequence += "101001010110" 'Year 1307H HijriMonthSequence += "101101001010" 'Year 1308H HijriMonthSequence += "110110100100" 'Year 1309H HijriMonthSequence += "110111010010" 'Year 1310H HijriMonthSequence += "010111011001" 'Year 1311H HijriMonthSequence += "001011011100" 'Year 1312H HijriMonthSequence += "100101011101" 'Year 1313H HijriMonthSequence += "010010101101" 'Year 1314H HijriMonthSequence += "101001010101" 'Year 1315H HijriMonthSequence += "101101001010" 'Year 1316H HijriMonthSequence += "101101101001" 'Year 1317H HijriMonthSequence += "010101110100" 'Year 1318H HijriMonthSequence += "100101110110" 'Year 1319H HijriMonthSequence += "010010110111" 'Year 1320H HijriMonthSequence += "001001010111" 'Year 1321H HijriMonthSequence += "010100101011" 'Year 1322H HijriMonthSequence += "011010010101" 'Year 1323H HijriMonthSequence += "011011001010" 'Year 1324H HijriMonthSequence += "101011010101" 'Year 1325H HijriMonthSequence += "010101011011" 'Year 1326H HijriMonthSequence += "001001011101" 'Year 1327H HijriMonthSequence += "100100101101" 'Year 1328H HijriMonthSequence += "110010010101" 'Year 1329H HijriMonthSequence += "110101001010" 'Year 1330H HijriMonthSequence += "111010100101" 'Year 1331H HijriMonthSequence += "011011010010" 'Year 1332H HijriMonthSequence += "101011010101" 'Year 1333H HijriMonthSequence += "010101011010" 'Year 1334H HijriMonthSequence += "101010101011" 'Year 1335H HijriMonthSequence += "010101001011" 'Year 1336H HijriMonthSequence += "011010100101" 'Year 1337H HijriMonthSequence += "011101010010" 'Year 1338H HijriMonthSequence += "101110101001" 'Year 1339H HijriMonthSequence += "001101110100" 'Year 1340H HijriMonthSequence += "101010110110" 'Year 1341H HijriMonthSequence += "010101010110" 'Year 1342H HijriMonthSequence += "101010101010" 'Year 1343H HijriMonthSequence += "110101010010" 'Year 1344H HijriMonthSequence += "110110101001" 'Year 1345H HijriMonthSequence += "010111010100" 'Year 1346H HijriMonthSequence += "101011101010" 'Year 1347H HijriMonthSequence += "010011011101" 'Year 1348H HijriMonthSequence += "001001101110" 'Year 1349H HijriMonthSequence += "100100101110" 'Year 1350H HijriMonthSequence += "101010100110" 'Year 1351H HijriMonthSequence += "110101010100" 'Year 1352H HijriMonthSequence += "110110101010" 'Year 1353H HijriMonthSequence += "010110110101" 'Year 1354H HijriMonthSequence += "001010110110" 'Year 1355H HijriMonthSequence += "100100110111" 'Year 1356H HijriMonthSequence += "010010011011" 'Year 1357H HijriMonthSequence += "101001001011" 'Year 1358H HijriMonthSequence += "101100100101" 'Year 1359H HijriMonthSequence += "101101010100" 'Year 1360H HijriMonthSequence += "101101101010" 'Year 1361H HijriMonthSequence += "010101101101" 'Year 1362H HijriMonthSequence += "010010101101" 'Year 1363H HijriMonthSequence += "101001010101" 'Year 1364H HijriMonthSequence += "110100100101" 'Year 1365H HijriMonthSequence += "111010010010" 'Year 1366H HijriMonthSequence += "111011001001" 'Year 1367H HijriMonthSequence += "011011010100" 'Year 1368H HijriMonthSequence += "101011101010" 'Year 1369H HijriMonthSequence += "010101101011" 'Year 1370H HijriMonthSequence += "010010101011" 'Year 1371H HijriMonthSequence += "011010010101" 'Year 1372H HijriMonthSequence += "101101001001" 'Year 1373H HijriMonthSequence += "101110100100" 'Year 1374H HijriMonthSequence += "101110110010" 'Year 1375H HijriMonthSequence += "010110110101" 'Year 1376H HijriMonthSequence += "001010111010" 'Year 1377H HijriMonthSequence += "100101011011" 'Year 1378H HijriMonthSequence += "010010101011" 'Year 1379H HijriMonthSequence += "010101010101" 'Year 1380H HijriMonthSequence += "011010110010" 'Year 1381H HijriMonthSequence += "011011011001" 'Year 1382H HijriMonthSequence += "001011101100" 'Year 1383H HijriMonthSequence += "100101101110" 'Year 1384H HijriMonthSequence += "010010101110" 'Year 1385H HijriMonthSequence += "101001010110" 'Year 1386H HijriMonthSequence += "110100101010" 'Year 1387H HijriMonthSequence += "110101010101" 'Year 1388H HijriMonthSequence += "010110101010" 'Year 1389H HijriMonthSequence += "101010110101" 'Year 1390H HijriMonthSequence += "010010111011" 'Year 1391H HijriMonthSequence += "001001011011" 'Year 1392H HijriMonthSequence += "100100101011" 'Year 1393H HijriMonthSequence += "101010010101" 'Year 1394H HijriMonthSequence += "101101001010" 'Year 1395H HijriMonthSequence += "101110100101" 'Year 1396H HijriMonthSequence += "010110101010" 'Year 1397H HijriMonthSequence += "101010110101" 'Year 1398H HijriMonthSequence += "010101010110" 'Year 1399H HijriMonthSequence += "101010010110" 'Year 1400H HijriMonthSequence += "110101001010" 'Year 1401H HijriMonthSequence += "111010100101" 'Year 1402H HijriMonthSequence += "011101010010" 'Year 1403H HijriMonthSequence += "011011101001" 'Year 1404H HijriMonthSequence += "001101101010" 'Year 1405H HijriMonthSequence += "101010101101" 'Year 1406H HijriMonthSequence += "010101010101" 'Year 1407H HijriMonthSequence += "101010100101" 'Year 1408H HijriMonthSequence += "101101010010" 'Year 1409H HijriMonthSequence += "101110101001" 'Year 1410H HijriMonthSequence += "010110110100" 'Year 1411H HijriMonthSequence += "100110111010" 'Year 1412H HijriMonthSequence += "010011011011" 'Year 1413H HijriMonthSequence += "001001011101" 'Year 1414H HijriMonthSequence += "010100101101" 'Year 1415H HijriMonthSequence += "101010100101" 'Year 1416H HijriMonthSequence += "101011010100" 'Year 1417H HijriMonthSequence += "101011101010" 'Year 1418H HijriMonthSequence += "010101101101" 'Year 1419H HijriMonthSequence += "010010111101" 'Year 1420H HijriMonthSequence += "001000111101" 'Year 1421H HijriMonthSequence += "100100011101" 'Year 1422H HijriMonthSequence += "101010010101" 'Year 1423H HijriMonthSequence += "101101001010" 'Year 1424H HijriMonthSequence += "101101011010" 'Year 1425H HijriMonthSequence += "010101101101" 'Year 1426H HijriMonthSequence += "001010110110" 'Year 1427H HijriMonthSequence += "100100111011" 'Year 1428H HijriMonthSequence += "010010011011" 'Year 1429H HijriMonthSequence += "011001010101" 'Year 1430H HijriMonthSequence += "011010101001" 'Year 1431H HijriMonthSequence += "011101010100" 'Year 1432H HijriMonthSequence += "101101101010" 'Year 1433H HijriMonthSequence += "010101101100" 'Year 1434H HijriMonthSequence += "101010101101" 'Year 1435H HijriMonthSequence += "010101010101" 'Year 1436H HijriMonthSequence += "101100101001" 'Year 1437H HijriMonthSequence += "101110010010" 'Year 1438H HijriMonthSequence += "101110101001" 'Year 1439H HijriMonthSequence += "010111010100" 'Year 1440H HijriMonthSequence += "101011011010" 'Year 1441H HijriMonthSequence += "010101011010" 'Year 1442H HijriMonthSequence += "101010101011" 'Year 1443H HijriMonthSequence += "010110010101" 'Year 1444H HijriMonthSequence += "011101001001" 'Year 1445H HijriMonthSequence += "011101100100" 'Year 1446H HijriMonthSequence += "101110101010" 'Year 1447H HijriMonthSequence += "010110110101" 'Year 1448H HijriMonthSequence += "001010110110" 'Year 1449H HijriMonthSequence += "101001010110" 'Year 1450H Return HijriMonthSequence End Function #End Region ' Function DateFormating(ByVal _Date As String) As String #Region " DateFormating( _Date As String) As String " Public Function DateFormating(ByVal _Date As String) As String ' / تجزئة نص التاريخ من الفاصل Dim dt() As String = Split(_Date, "/") '------------------------------------------------------ ' في حالة عدم وجود فاصل تاريخ أصلا فيتم المغادرة If dt.Length <> 3 Then Return "" '------------------------------------------------------ ' التأكد أن أجزاء التاريخ هي أرقام فعلا For i = 0 To dt.Length - 1 If Not IsNumeric(dt(i)) Then Return "" End If Next i '------------------------------------------------------ ' ترتيب التاريخ بحيث يبدأ باليوم وينتهي السنة If Val(dt(0)) > 999 And Val(dt(2)) < 99 Then Dim a As String = Val(dt(0)) Dim b As String = Val(dt(2)) dt(0) = b : dt(2) = a End If '------------------------------------------------------ ' التأكد من عدم تجاوز كل جزء الحدود المسموح له If Val(dt(2)) < 1301 Or Val(dt(2)) > 2029 Then Return "" ' عدم تجاوز الشهر عن 12 If Val(dt(1)) < 1 _ Or Val(dt(1)) > 12 Then Return "" End If ' عدم تجاوز اليوم الهجري عن 30 If Val(dt(2)) >= 1301 _ And Val(dt(2)) <= 1450 Then If Val(dt(0)) < 1 Or Val(dt(0)) > 30 Then Return "" End If '------------------------------------------------------ Dim y As Integer, m As Integer, d As Integer d = Val(dt(0)).ToString("00") m = Val(dt(1)).ToString("00") y = Val(dt(2)).ToString("0000") Return Val(dt(0)).ToString("00") _ & "/" & Val(dt(1)).ToString("00") _ & "/" & Val(dt(2)).ToString("0000") End Function #End Region '#End Region #Region " ArabicWeekdayString " Private Function ArabicWeekdayString(ByVal weekdayValue As Integer) Dim w As String = String.Empty Select Case weekdayValue Case 7 w = "Saturday" Case 1 w = "Sunday" Case 2 w = "Monday" Case 3 w = "Tuesday" Case 4 w = "Wednesday" Case 5 w = "Thursday" Case 6 w = "Friday" End Select Return w End Function #End Region #Region " HiriMonthString " Private Function HiriMonthString(ByVal hijriMonthValue As Integer) Dim m As String = String.Empty Select Case hijriMonthValue Case 1 m = "Muharram" Case 2 m = "Safar" Case 3 m = "Rabi al-Awwal" Case 4 m = "Rabi ath-Thani" Case 5 m = "Jumada al-Ula" Case 6 m = "Jumada al-Akhirah" Case 7 m = "Rajab" Case 8 m = "Shaaban" Case 9 m = "Ramadan" Case 10 m = "Shawwal" Case 11 m = "Dhu al-Qaadah" Case 12 m = "Dhu al-Hijjah" End Select Return m End Function #End Region #Region " GregorianMonthString " Private Function GregorianMonthString(ByVal gregorianMonthValue As Integer) Dim m As String = String.Empty Select Case gregorianMonthValue Case 1 m = "January" Case 2 m = "February" Case 3 m = "March" Case 4 m = "April" Case 5 m = "May" Case 6 m = "June" Case 7 m = "July" Case 8 m = "August" Case 9 m = "September" Case 10 m = "October" Case 11 m = "November" Case 12 m = "December" End Select Return m End Function #End Region End Module ملاحظة: حقوق بعض الاكواد من google ارجو ان ينال موضوعي اعجابكم. حسنين Hijri_SEMO_Pa3x.rar

السلام عليكم وانا كذلك ، البرنامج عندي شغال 🙂 واليك طريقة اخرى ، مشابهة لطريقة اخي kanory 🙂 في النموذج ، وعلى حدث "فتح النموذج" اكتب هذا الكود: Private Sub Form_Open(Cancel As Integer) str_Title = "الرقم السري مطلوب" str_Prompt = "ادخل الرقم السري" If InputBoxDK(str_Prompt, str_Title) = DLookup("[Pass]", "Pass", "[Pass]") Then MsgBox "الرقم السري صحيح", , "تفضل بالدخول" 'DoCmd.Close DoCmd.OpenForm "employees_F", acNormal Else MsgBox "الرقم السري خاطىء", , "لا يمكنك الدخول" DoCmd.CancelEvent End If End Sub . والذي ينادي الوحدة النمطية: Option Compare Database Option Explicit '-------------------------------------------------------------------- ' ' Copyright 1996-2013 J Street Technology, Inc. ' www.JStreetTech.com ' ' This code may be used and distributed as part of your application ' provided that all comments remain intact. ' ' J Street Technology offers this code "as is" and does not assume ' any liability for bugs or problems with any of the code. In ' addition, we do not provide free technical support for this code. ' ' Code for Password-masked InputBox was originally written by ' Daniel Klann in March 2003 and has been adapted & updaed for 64-bit ' compatiblity '-------------------------------------------------------------------- 'Revised Type Declare for compatability with NT 'Re-revised for 64-bit compatibility #If VBA7 Then Type tagOPENFILENAME lStructSize As Long hwndOwner As LongPtr hInstance As LongPtr lpstrFilter As String lpstrCustomFilter As Long nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As LongPtr lpfnHook As LongPtr lpTemplateName As Long End Type Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Boolean 'APIs for Password-masked Inputbox Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _ ByVal hHook As LongPtr, _ ByVal ncode As Long, _ ByVal wParam As LongPtr, _ lParam As Any _ ) As LongPtr Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _ ByVal lpModuleName As String _ ) As LongPtr Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _ ByVal idHook As Long, _ ByVal lpfn As LongPtr, _ ByVal hmod As LongPtr, _ ByVal dwThreadID As Long _ ) As LongPtr Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _ ByVal hHook As LongPtr _ ) As Long Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" ( _ ByVal hDlg As LongPtr, _ ByVal nIDDlgItem As Long, _ ByVal wMsg As Long, _ ByVal wParam As LongPtr, _ ByVal lParam As LongPtr _ ) As LongPtr Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" ( _ ByVal hwnd As LongPtr, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long _ ) As Long Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long Private hHook As LongPtr #Else Type tagOPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As Long nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As Long End Type Private Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long 'APIs for Password-masked Inputbox Private Declare Function CallNextHookEx Lib "user32" ( _ ByVal hHook As Long, _ ByVal ncode As Long, _ ByVal wParam As Long, _ lParam As Any _ ) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _ ByVal lpModuleName As String _ ) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _ ByVal idHook As Long, _ ByVal lpfn As Long, _ ByVal hmod As Long, _ ByVal dwThreadID As Long _ ) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" ( _ ByVal hHook As Long _ ) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" ( _ ByVal hDlg As Long, _ ByVal nIDDlgItem As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long _ ) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _ ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long _ ) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long Private hHook As Long #End If 'Constants used by Password-masked Inputbox Private Const EM_SETPASSWORDCHAR As Long = &HCC Private Const WH_CBT As Long = 5 Private Const HCBT_ACTIVATE As Long = 5 Private Const HC_ACTION As Long = 0 #If VBA7 Then Private Function InputBoxPasswordMaskProc( _ ByVal lngCode As Long, _ ByVal wParam As LongPtr, _ ByVal lParam As LongPtr _ ) As LongPtr #Else Private Function InputBoxPasswordMaskProc( _ ByVal lngCode As Long, _ ByVal wParam As Long, _ ByVal lParam As Long _ ) As Long #End If 'DO NOT PUT IN VBA ERROR HANDLING 'This is a Windows procedure called by Message loop. On Error Resume Next 'Originally written by Daniel Klann 'Updated for 64-bit compatibility Dim RetVal Dim strClassName As String Dim lngBuffer As Long If lngCode < HC_ACTION Then InputBoxPasswordMaskProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If 'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function 'Private Function InputBoxDK( _ Function InputBoxDK( _ Prompt, _ Optional Title, _ Optional Default, _ Optional XPos, _ Optional YPos, _ Optional HelpFile, _ Optional Context _ ) As String 'Originally written by Daniel Klann 'Updated for 64-bit compatibility 'Replicate the functionality of Inputbox function 'while providing password masking. #If VBA7 Then Dim lngModHwnd As LongPtr #Else Dim lngModHwnd As Long #End If Dim lngThreadID As Long On Error GoTo ErrHandler lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf InputBoxPasswordMaskProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook ExitProc: On Error Resume Next Exit Function ErrHandler: Select Case Err.Number Case Else VBA.MsgBox "Error " & Err.Number & " (" & Err.Description & ")" End Select Resume ExitProc Resume 'for Debugging End Function 'Hope someone can use it! . جعفر 983.password.accdb.zip

اعزائي رواد المنتدى الفاضل اقدم لكم فكرة وطريقة في تحويل التاريخ الميلادي الى تاريخ ام القرى وهو الى حد ما التاريخ الهجري . وذلك باستخدام مكتبات الاكسل ! كما انه وعد مني للاخ والأستاذ أبو خليل وفي احد المناقشات وجب على الوفاء به ! وقد كانت هذه الفكرة طرحتها في احد المنتديات الشقيقة ولكن بدون مثال او تنفيذ . اترككم مع المثال املا الاستفادة منه وطرح آراؤكم ومقترحاتكم البناءة ! لكم خالص تحياتي Private Sub أمر4_Click() ''رمهان '' اوفيسنا ''abc_2_me@hotmail.com '' هدية للاخ ابو خليل Set xl = CreateObject("Excel.Sheet") xl.Application.Range("A1").Value = CDate(t2) xl.Application.Range("A1").NumberFormat = "[$-1170000]B2yyyy-mm-dd;@" t1 = xl.Application.Range("A1").Text xl.Application.Quit Set xl = Nothing End Sub رمهان - ام القرى.rar

Sub printpreview1() 'كود معاينة طباعة مطاطي Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).printpreview End Sub Sub print_2() 'كود طباعة مطاطي Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).PrintOut End Sub كود معاينه طباعة مطاطي وكود طباعة مطاطي

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

السلام عليكم يمكن التعديل بعدة طرق 1- يمكنك اثناء البحث استخدام متغير لتخزين ارقام الصفوف لنتائج البحث (هذا ما استخدمته في المرفق) 2- يمكنك اثناء البحث تخزين ارقام الصفوف لنتائج البحث في عمود اضافي من اعمدة اللست بوكس ( يتم اخفاءه ) شاهد المرفق 2010 بحث وتعديل فى حالة تكرار الكود.rar

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

أختنا الكريمة أم بندر نظراً لعدم وجود تصور محدد عن شكل التقرير المطلوب فقد قمت بعمل تقريرين جديدين للفصلين الاول والثاني مطابقة لكشوفات المعدلات ولكن على مستوى المرحلة . فأرجو أن يكون البرنامج بنسخته النهائية ملبياً لكافة متطلبات العمل وأي تعديلات أو تحديثات أنا حاضر إن شاء الله . تحياتي,,, برنامج العلامات المدرسية.rar