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

شكراً للأستاذ صالح على توضيح تلك النقطة التي غفلت عنها ..وكما قال الاخ kanory اجعل بقية النماذج لاتفتح الا اذا كان النموذج الرئيسي مفتوح..ولو لم ترغب في جعل النموذج الرئيسي مفتوح فقم بعمل خدعة صغيرة كالتالي اجعل جميع النماذج لاتفتح الا اذا كانت قيمة x = true السؤال: كيف يمكن لقيمة x ان تكون true؟ الجواب: فقط عندما يتم غلق النموذج الرئيسي بهذه الطريقة سوف لن يتمكن احد من العبث بنموذج بدء التشغيل لديك إليك المثال السابق بعد التعديل تحياتي example2.mdb

Rs=Format(Nz(DSum("[madeen]-[daaen]";"r1";"Nz([ID_r];0)<=" & Nz([ID_r];0));0);"#,###" & 0)

أخي الكريم قم بانشاء مايكرو يجب ان يكون اسمه Autoexec ومن ثم قم بانشاء وحدة نمطية كالتالي Option Compare Database Function StartupForm() On Error Resume Next DoCmd.OpenForm "StartupFrm" End Function غير فيها اسم نموذج بدء التشغيل الذي تريده الآن استدعي الدالة تلك في المايكرو كما في الصورة التالية وفي الاخير قم باقفال الوحدات النمطية بباسورد ومن ثم حول قاعدة البيانات الى mde او Accde

دائما اذا بترفقون نسخة مصغرة من قاعدة بياناتكم راح توصلون الى النتيجة باسرع وقت ممكن

السلام عليكم ورحمة الله تعالى وبركاته أقدم لكم دالة تفقيط التاريخ لن أطيل عليكم الدالة في المرفق لا تنسونا من خالص دعائكم Function DateToLettre(Dat As Date) As String ' Created By Benkhalifa ' Djemoui Alger: 23/02/2018 Dim MyDays As Variant Dim MyMonths As Variant Dim MyChif As Variant Dim Cent As String Dim Mill As String Dim i, J As Byte: J = 0 '=============================================================================================================================== MyDays = Array("اليوم الأول", "اليوم الثاني", "اليوم الثالث", _ "اليوم الرابع", "اليوم الخامس", "اليوم السادس", _ "اليوم السابع", "اليوم الثامن", "اليوم التاسع", _ "اليوم العاشر", "اليوم الحادي عشر", "اليوم الثاني عشر", _ "ليوم الثالث عشر", "اليوم الرابع عشر", "اليوم الخامس عشر", _ "اليوم السادس عشر", "اليوم السابع عشر", "اليوم الثامن عشر", _ "اليوم التاسع عشر", "اليوم العشرون", "اليوم الواحد و العشرون", _ "اليوم الثاني و العشرون", "اليوم الثالث و العشرون", "اليوم الرابع و العشرون", _ "ليوم الخامس و العشرون", "اليوم السادس و العشرون", "اليوم السابع و العشرون", _ "اليوم الثامن و العشرون", "اليوم التاسع و العشرون", "اليوم الثلاثون", _ "اليوم الواحد و الثلاثون") '=============================================================================================================================== MyMonths = Array("شهر يناير", "شهر فبراير", "شهر مارس", _ "شهر أبريل", "شهر مايو", "شهر يونيو", _ "شهر يوليو", "شهر اغسطس", "شهر سبتمبر", _ "شهر أكتوبر", "شهر نوفمبر", "شهر ديسمبر") '=============================================================================================================================== MyChif = Array("صفر", "واحد", "إثنان", "ثلاث", "أربع", "خمس", "ست", "سبع", "ثمان", "تسع", _ "عشرة", "إحدى عشر", "إثنى عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", _ "تسعة عشر", "عشرون", "واحد و عشرون", "إثنان و عشرون", "ثلاثة و عشرون", "أربعة و عشرون", "خمسة و عشرون", "ستة و عشرون", _ "سبعة و عشرون", "ثمانية و عشرون", "تسعة عشرون", "ثلاثون", "واحد و ثلاثون", "إثنان و ثلاثون", "ثلاثة و ثلاثون", "أربعة و ثلاثون", _ "خمسة و ثلاثون", "ستة و ثلاثون", "سبعة و ثلاثون", "ثمانية و ثلاثون", "تسعة و ثلاثون", "أربعون", _ "واحد و أربعون", "إثنان و أربعون", "ثلاثة و أربعون", "أربعة و أربعون", "خمسة و أربعون", "ستة و أربعون", _ "سبعة و أربعون", "ثمانية و أربعون", "تسعة و أربعون", "خمسون", "واحد و خمسون", "إثنان و خمسون", "ثلاثة و خمسون", "أربعة و خمسون", _ "خمسة و خمسون", "ستة و خمسون", "سبعة و خمسون", "ثمانية و خمسون", "تسعة و خمسون", "ستون", "واحد و ستون", _ "إثنان و ستون", "ثلاثة و ستون", "أربعة و ستون", "خمسة و ستون", "ستة ستون", _ "سبعة و ستون", "ثمانية و ستون", "تسعة و ستون", "سبعون", "واحد و سبعون", "إثنان و سبعون", "ثلاثة و سبعون", _ "أربع و سبعون", "خمس و سبعون", "ستة و سبعون", "سبعة و سبعون", "ثمانية و سبعون", "تسعة و سبعون", "ثمانون", "واحد و ثمانون", _ "إثنان و ثمانون", "ثلاث و ثمانون", "أربعة و ثمانون", "خمسة و ثمانون", "ستة و ثمانون", "سبعة و ثمانون", _ "ثمانية و ثمانون", "تسع و ثمانون", "تسعون", "واحد و تسعون", "إثنان و تسعون", "ثلاثة و تسعون", "أربعة و تسعون", _ "خمسة و تسعون", "تسعون", "سبعة و تسعون", "ثمانية و تسعون", "تسعة و تسعون", " مائة ") '=============================================================================================================================== Do While J < 2 i = Mid$(Year(Dat), J + 1, 4) '=============================================================================================================================== If Len(i) = 4 Then Select Case i Case 1 To 999: Mill = MyChif(i) Case 1000 To 9999: Select Case Int(i / 1000) Case 1: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = " ألف" Else: Mill = " ألف و " Case 2: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = " ألفان" Else Mill = " ألفان و " Case 3 To 10: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = MyChif(Int(i / 1000)) & " آلاف" Else If Int(i / 1000) = 8 Then Mill = MyChif(Int(i / 1000)) & "ية آلاف و " Else Mill = MyChif(Int(i / 1000)) & "ة آلاف و " End Select End Select End If '=============================================================================================================================== If Len(i) = 3 Then Select Case i Case 1 To 100: Cent = MyChif(i) Case 101 To 199: Cent = " مائة و " & MyChif(i Mod 100) Case 201 To 299: Cent = " مائتان و " & MyChif(i Mod 100) Case 300 To 999: Select Case (i Mod 100) Case 0: If Format(Mid$(i, 2, 4), "00") = "00" Then Cent = MyChif(Int(i / 100)) & " مائة " Else Cent = MyChif(Int(i / 100)) & " مائة و " Case 1 To 99: Cent = MyChif(Int(i / 100)) & "مائة و " & MyChif(i Mod 100) End Select End Select End If '=============================================================================================================================== J = J + 1 Loop '=============================================================================================================================== DateToLettre = MyDays(Day(Dat) - 1) & " من " & MyMonths(Month(Dat) - 1) & " عام " & Mill & Cent End Function منقول لنشر العلم جزى الله .. المحترم الخلوق بن خليفه الجموعي بكل خير دالة تفقيط التاريخ.rar

بسم الله الرحمان الرحيم السلام عليكم اغلبيتنا يعلم بان الاكسل جيد في انشاء برامج حسابية صغيرة لاكن مع مرور الوقت و زيادة حجم قاعدة البيانات للبرنامج يصبح هناك نوع من البطئء و التشنج في البرنامج لان الاكسل عبارة عن جداولة الكترونية و ليس بقاعدة بيانات و ايضا كما نعلم بان الاكسيس جيد جدا بالنسبة الاكسل لاستخدامه كقاعدة بيانات وب بالفعل الاكسيس مازال لحد الان يستعمل كقاعدة البيانات في البرامج المتوسطة لذى فكرة في دمج الاكسل و الاكسيس معا للستفادة من قوة الاكسل في الجداول و الحسابات و جمال الفورم مع الاكسيس المتميز في قوة قاعدة البيانات و عدم تاثره كثيرا بكبر حجمها كما هو معمول مع لغات البرمجة الكبيرة ك c++ vb.net java python ...... اذن ستجدون في هذا الموضوع مثال شامل لربط الاكسل بالاكسيس فقط بالاكواد بحيث سنتعامل مع الاكسيس بسلاسة كبيرة وذلك استخدام اوامر sql مع vbq بسهولة كبيرة وتنفذ جميع الاوامر من حذف او اضافة او تعديل او التقارير المعروف بها الاكسيس من خلال الاكسل دون فتح ملف الاكسيس (في الحقيقة يفتح ملف الاكسيس لاكن لن تلاحظ ابدا بانه مفتوح) والعملية المتبعة في ذلك مقسمة الى ثلاث مراحل فتح اتصال مع الاكسيس تنفيذ اوامر sql (select insert update delete) غلق الاتصال مع الاكسيس لا اطيل عليكم و اترككم مع الملف و لاي استفسارات انا في الخدمة تحياتي للجميع و ارجو ان تستفيدو من الموضوع ConnectDatabaseAccess.rar

السلام عليكم بعد اذن استاذنا الغالي شيفان و اسأل الله ان يجعل ما يقدمه لخدمة اخواننا في موازين حسناته يمكن استبدال تلك الرسالة بوضع الكود التالي بحدث عند الخطأ لنموذج البدء If DataErr = 3043 Or DataErr = 3024 Or DataErr = 3044 Or DataErr = 3078 Then Response = MsgBox("اتصال خاطئ بالمصدر", vbExclamation, "اتصال خاطئ") Response = acDataErrContinue DoCmd.RunCommand (acCmdLinkedTableManager) DoCmd.Quit End If و حل آخر تجده بالرابط ادناه للاستاذ الغالي ابو خليل جزاه الله كل خير تفضل من هنا بالتوفيق

لحسن العمل مع لغة VBA تم تغيير اسماء الصفحات الى الاجنبية الكود Option Explicit Sub filter_for_ME() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim S_sh As Worksheet: Set S_sh = Sheets("MouwariDDin") Dim T_sh As Worksheet: Set T_sh = Sheets("Search_") Dim My_Table As Range: Set My_Table = S_sh.Range("A1").CurrentRegion T_sh.Range("a5").CurrentRegion.ClearContents T_sh.Range("q2").Formula = "=AND($A2>=Search_!$B$2,$A2<=Search_!$B$3,Search_!$C$2=$B2,Search_!$D$2=$D2)" My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=T_sh.Range("Q1:q2"), _ CopyToRange:=T_sh.Range("A5:G5") T_sh.Range("q2").ClearContents With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف معادلة ترحيل ونقل Salim.xls

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

ضع مثال لو تكرمت كيفيفة اجبار النمازج بالقيمة x sandanet لو تكرمت اريد اخر شي توصلتم اليه بشان حماية قواعد البيانات من السرقة بالاضافة لامكانية التوزيع كنسخة تجريبية والتفعيل بكود ياريت علي الايمل ibnjabalapp@gmail.com وياريت بقية الاعضاء تساعدوني

اخي اجعل النماذج الاخرى لا تفتح الا بفتح نموذج التسجيل .

يجب تترك مكان اسم النموذج في display form فارغا

إخوانى العزاء السلام عليكم جميعا كلام الأستاذ احمد العيسى مضبوط فعلا أنا بعمل عليه من حوالى أربع سنين تقريبا Teacher-Class ولكن على جزء من الجداول الموجودة به وهو فعلا جميل بس بقوم بادخال الحصص والمواد يدويا وليس آليا كجدول العرف وله كل الشكر على ذلك ثانيا استاذ / حمدى هناك وحدات نمطيه منها وحدة نمطيه اشغال دى المسئوله عن ادخال الايام فى جدول اشغال واذا كانت مدستك تعمل من السبت الى الخميس يكون عدد الحقول 8 حصص +8 مواد *6 ايام يكون عدد الحقول 96 لو عندك 5 أيام فقط من الحد ال الخميس يبقى عندنا 80 حقلقم بالغاء يوم السبت بمواده من الجداول وفى الحاله دى هاتبدأ من الحقل 3 For L = 3 To 82 Step 2 ولو على 6 ايام For L = 3 To 98 Step 2 هذا على قدر ما فهمت دمتم جميعا بخير

تخزين البيانات في cookies الطرق الآمنة لإرسال البيانات للخادم Server . 1. View State 2. Hidden File 3. Query String 4. Cookies 5. Session (1) View State ViewState["UserName"] = "Leo"; Label1.Text = ViewState["UserName"].ToString(); (2) Hidden File أولا نضع الأداة Hidden File على الصفحة . HiddenField1.Value = "3"; Label1.Text = HiddenField1.Value; (3) Query String أولا من الصفحة الرئيسية نكتب كود الاستدعاء للصفحة الفرعية . Response.Redirect("Calc.aspx?id=3&name=Leo"); ثانيا في الصفحة الفرعية نكتب كود استلام البيانات txtID.Text = Request.QueryString["id"].ToString(); txtName.Text = Request.QueryString["name"].ToString(); (4) Cookies تنفع هذه الطريقة في حالة تذكير بكلمة المرور حيث يتم تخزين الملف في الجهاز المحلي الذي يستدعيه الخادم لنقل البيانات في حالة أمنة . HttpCookie pwCookie = new HttpCookie("password","123456"); Response.Cookies.Add(pwCookie); Response.Redirect("Calc.aspx"); كود استلام البيانات من الخادم string vpw; vpw = Request.Cookies["password"].Value; (5) Session هذه آمن طريقة لتمرير اسم المستخدم وكلمة المرور وهي عبارة عن جلسة أقصى مدتها 20 دقيقة وتمسح البيانات من ذاكرة العمل بالخادم. Session["userName"] = "Leo"; Session["password"] = "123456"; Response.Redirect("Calc.aspx"); كود استلام البيانات من الخادم string username; username = Session["userName"].ToString(); string vpw; vpw = Session["password"].ToString();

DoCmd.OpenForm "اضافة_سند_صرف" Forms!اضافة_سند_صرف![الرقم الوظيفي].Value = Nz(DMax("[رقم سند القبض]", "اضافة سند قبض") + 1, 1) او بعد التحديث عند ادخال التاريخ Me.[الرقم الوظيفي].Value = Nz(DMax("[رقم سند القبض]", "اضافة سند قبض") + 1, 1)

تفضل example.mdb

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

توصلت لطريقة فتح التقرير أولا هكذا بالوضع المخفي DoCmd.OpenReport stDocName, acViewReport, , stlinkcriteria, acHidden ومن ثم يتم تنفيذ أمر تصدير التقرير لا أعلم ان كانت هناك طريقة مختصرة الف شكر اخي ابو ياسين

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

ممكن مثال شوف يمكن تعمل الشرط في مصدر التقرير

السلام عليكم أهل المنتدى الكرام أقدم لكم هذا البرنامج الجاهز لإدارة وطباعة الشيكات-والبرنامج مرفوع على : http://www.mediafire.com/file/yfgc3ggmfyiv5fd/cm_setup-1.3.0.30-برنامج+طباعة+الشيكات+عربي+مجاني+كامل.exe

أخي الكريم حمدي الظابط تحية طيبة وبعد ... انا انتظر منك النسخة الكاملة ان شاء الله بعد الانتهاء منها وانا ان شاء الله احاول المساعدة قدر الامكان بالنسبة للمشكلة المتعلقة بنموذج me-2 فقم بتغيير الجزء الموجود في كود حدث عند الفتح الى هذا الكود Do While tc.EOF = False For L = 3 To 100 Step 2 Select Case tc.Fields(L) = F!الصف فقط غير الرقم 81 الى 100 وان شاء الله تنحل مشكلة يوم الخميس

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

جرب هذا Dim i, x As Integer x = Me.tr i = Me.T2 If i > x And Me.types = "سند صرف" And i <>""Then MsgBox ("لايمكنك الحفظ !! فرصيد الصندوق غير كاف ") Me.Undo Else

طلب الي احد الاصدقاء وضع كود لادراج رزنامة لسنة محددة وشهر محدد مع تمييز (يوم معيّن) من هذا الشهر فكان هذا الكود الذي ارجو ان يستفيد منه الاخرون قبل تنفيذ الكود الكود: تسمية الصفحة التي تريد العمل عليها بهذا الاسم "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

بعد اذن الاخوة الكرام .. تفضل جرب المثال المرفق example.zip

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم ابوحمادة كود قسمة1.rar

لسة مصممه حالا اتفضل لو عجبك اضغط like شئون موظفين بسيط.rar

شكرا ابا آدم على المتابعة والمساندة وهو تسجيل بعض النتائج المهمة في الحدث . ويهمنا هنا درجة الامان ، فلا بد من شاهد او دليل على درجة الامان الابتدائية فحين يغلق النظام تذهب جميع البيانات العالقة في الذاكرة ، وهذه لا بد من اخذ حسابها من اجل ضبط العملية لذا سيكون من ضمن الكائنات المساعدة حقل في جدول نودع فيه درجة الامان قبل اغلاق النظام لذا سننشء جدولا باسم tblTemp به حقل رقمي باسم tmp دعونا الآن نعرض الاجراءات الاخرى التي سنستخدمها في العملية غير ما تم ذكره اعلاه 1- وحدة نمطية عامة وهي المسؤولة عن تسجيل المكتبات : Option Compare Database Option Explicit Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lLibFileName As String) As Long Private Declare Function CreateThread Lib "kernel32" (lThreadAttributes As Any, ByVal lStackSize As Long, ByVal lStartAddress As Long, ByVal larameter As Long, ByVal lCreationFlags As Long, lThreadID As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal lMilliseconds As Long) As Long Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lProcName As String) As Long Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lExitCode As Long) As Long Private Declare Sub ExitThread Lib "kernel32" (ByVal lExitCode As Long) 'Purpose : This function registers and Unregisters OLE components 'Inputs : sFilePath The path to the DLL/OCX or ActiveX EXE ' bRegister If True Registers the control, else unregisters control 'Outputs : Returns True if successful 'Author : Andrewb 'Date : 04/09/2000 'Notes : This is the API equivalent of RegSvr32.exe. 'Example : ' If RegisterComponent("C:\MyPath\MyFile.dll") = True Then ' Msgbox "Component Successfully Registered" ' Else ' Msgbox "Failed to Registered Component" ' End If 'Revisions : 1/Jan/2002. Updated to include code for registering ActiveX Exes. Function RegisterComponent(ByVal sFilePath As String, Optional bRegister As Boolean = True) As Boolean Dim lLibAddress As Long, lProcAddress As Long, lThreadID As Long, lSuccess As Long, lExitCode As Long, lThread As Long Dim sRegister As String Const clMaxTimeWait As Long = 20000 'Wait 20 secs for register to complete On Error GoTo ErrFailed If Len(sFilePath) > 0 And Len(Dir(sFilePath)) > 0 Then 'File exists If UCase$(Right$(sFilePath, 3)) = "EXE" Then 'Register/Unregister ActiveX EXE If bRegister Then 'Register EXE Shell sFilePath & " /REGSERVER", vbHide Else 'Unregister ActiveX EXE Shell sFilePath & " /UNREGSERVER", vbHide End If RegisterComponent = True Else 'Register/Unregister DLL If bRegister Then sRegister = "DllRegisterServer" Else sRegister = "DllUnRegisterServer" End If 'Load library into current process lLibAddress = LoadLibraryA(sFilePath) If lLibAddress Then 'Get address of the DLL function lProcAddress = GetProcAddress(lLibAddress, sRegister) If lProcAddress Then lThread = CreateThread(ByVal 0&, 0&, ByVal lProcAddress, ByVal 0&, 0&, lThread) If lThread Then 'Created thread and wait for it to terminate lSuccess = (WaitForSingleObject(lThread, clMaxTimeWait) = 0) If Not lSuccess Then 'Failed to register, close thread Call GetExitCodeThread(lThread, lExitCode) Call ExitThread(lExitCode) RegisterComponent = False Else 'Successfully registered component RegisterComponent = True Call CloseHandle(lThread) End If End If Call FreeLibrary(lLibAddress) Else 'Object doesn't expose OLE interface Call FreeLibrary(lLibAddress) End If End If End If End If Exit Function ErrFailed: Debug.Print Err.Description Debug.Assert False On Error GoTo 0 End Function 2- وحدة نمطية لقراءة نوع النظام 32بت أو 64بت Public Function IsWin32OrWin64() As String Dim proc_query As String Dim proc_results As Object Dim info As Object proc_query = "SELECT * FROM Win32_Processor" Set proc_results = GetObject("Winmgmts:").ExecQuery(proc_query) For Each info In proc_results IsWin32OrWin64 = info.AddressWidth & "-bit" Next info End Function 3- وحدة نمطية للتأكد من وجود الملف قبل النسخ واللصق : Public Function DoesFileExist(vPathAndFile As String) As Boolean If Len(Dir$(vPathAndFile)) > 0 Then DoesFileExist = True Else DoesFileExist = False End Function 4- وحدة نمطية تقوم بنسخ الملفات من برنامجنا الى المكان الذي نحدده Function CopyFile(vPathSource As String, vPathDestination As String) As Boolean FileCopy vPathSource, vPathDestination CopyFile = True End Function 5- عملية النسخ والتسجيل وتم وضعها في وحدة نمطية عامة : Public Function tsjeelMktbat() Dim sjel As Variant sjel = IsWin32OrWin64() If sjel = "32-bit" Then If Not DoesFileExist("C:\Windows\System32\Barcodex.ocx") Then 'للتأكد من عدم وجود الملف CopyFile CurrentProject.Path & "\Barcodex.ocx", "C:\Windows\System32\Barcodex.ocx" 'نسخ الملف في المكان المحدد RegisterComponent ("C:\Windows\System32\Barcodex.ocx") 'تسجيل الملف Else RegisterComponent ("C:\Windows\System32\Barcodex.ocx") ' وان كان الملف موجود سجله End If 'يمكن اضافة اكثر من ملف اعلاه ElseIf sjel = "64-bit" Then If Not DoesFileExist("C:\Windows\SysWOW64\Barcodex.ocx") Then CopyFile CurrentProject.Path & "\Barcodex.ocx", "C:\Windows\SysWOW64\Barcodex.ocx" RegisterComponent ("C:\Windows\SysWOW64\Barcodex.ocx") Else RegisterComponent ("C:\Windows\SysWOW64\Barcodex.ocx") End If End If End Function يتبع ...