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

ابشروا تبقى قليل للدورة لعمل تطبيق مربوط بالاكسس وعرض التقارير والمعلومات الاساسية به .

من عيونى يا باش مهندس شرح الاكواد بالوحدة النمطية تفصيلا اولا اسم الجدول ولانه سوف يتم استخدامه كثيرا ولاننى احببت تصعيب الامر قليلا استخدمت الـ Unicode Public Function tblUUID() tblUUID = Chrw("85") & Chrw("115") & Chrw("121") & Chrw("115") & Chrw("83") & Chrw("101") & Chrw("99") & Chrw("117") & Chrw("114") & Chrw("101") & Chrw("100") End Function فلو قمنا بقرائته فى نافذة immediate من خلال ?tblUUID() لتنتج لنا اسم الجدول UsysSecured كما فى الصورة الاتية 2- التأكد من وجود الجدول فى قاعدة البيانات من عدمه Public Function ifTableExists(tblName As String) As Boolean If DCount("[Name]", "MSysObjects", "[Name] = '" & tblName & "'") = 1 Then ifTableExists = True End Function 3- السطر الاول انشاء الجدول من خلال استعلام السطر الثانى تشغيل الـ Function الاتى ChckUUID ,وسيتم شرحه لاحقا Public Function CrtTblUUID() DoCmd.RunSQL "CREATE TABLE " & tblUUID & "([ID] counter," & "[UUIDPC] text," & "[ApprovedNo] text," & "CONSTRAINT [Index1] PRIMARY KEY ([ID]));" ChckUUID End Function 4- التأكد من وجود قيم فى الجدول Public Function CountRec() As Boolean If DCount("*", tblUUID) = 1 Then CountRec = True End Function 5-التأكد من صلاحية مقتاح التسجيل الذى ارسلته لكم عند التجربة من خلال استخدام عدد 2 Function - ToGetAprv - GetUUID() وسيأتى شرحهم تباعا Public Function ChkApprovedNo() As Boolean If DLookup("ApprovedNo", tblUUID) = ToGetAprv(GetUUID()) Then ChkApprovedNo = True End Function ملاحظة عند الشرح الان وحدتنى قمت بعمل function باسم اخر لنفس الوظيفة وسوف اقوم بحذفه اسم ال function هو Public Function validat() As Boolean اعتذر على ذلك الخطأ 6- هذا ال Function للخثول على معرف فريد للجهاز يدعى UUID وببساطه هو هو اختصار للمعرف الفريد العالمي ، وهو معرف فريد يتم إنشاؤه آليًا ضمن نطاق معين يتم إنشاؤها بواسطة خوارزمية معينة تحدد المواصفات والعناصر بما في ذلك عنوان MAC لبطاقة الشبكة والطابع الزمني ومساحة الاسم (Namespace) والرقم العشوائي أو العشوائي الزائف والتوقيت والعناصر الأخرى وخوارزمية إنشاء UUID من هذه العناصر تعني الخصائص المعقدة لـ UUID أنه لا يمكن إنشاؤها إلا عن طريق الكمبيوتر مع ضمان تفردها Public Function GetUUID() Dim strComputer As String Dim objWMIService, colItems, objItem strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct", , 48) For Each objItem In colItems GetUUID = objItem.UUID Next End Function 7- اغلاق جميع النماذج المفتوحة ما عدا نموذج FrmNotReg ولعدم تسهيل الامر على العابثين تم استخدام الـ unicode فى كتابة اسم النموذج Public Function DoCloseForms() Dim F As Access.Form Dim i As Long For i = Forms.Count - 1 To 0 Step -1 Set F = Forms(i) If F.Name <> _ Chrw("70") & Chrw("114") & Chrw("109") & Chrw("78") & Chrw("111") & Chrw("116") & Chrw("82") & Chrw("101") & Chrw("103") _ Then DoCmd.Close acForm, F.Name End If Next i End Function فى النقطة رقم 5 فى الشرح قلت سوف يأتى لاحقا شرح الـ 2 function الاتى ذكر اسمائهم - ToGetAprv - GetUUID() GetUUID -- تم شرحة فى النقطة رقم 6 الـ ToGetAprv هو function يتم تمرير قيمة GetUUID() الجهاز الحالى اليه ليقوم بتحويله الى unicode يعنى من ظهر لهم هذا الرقم الخاص بالنسخة فى نموذج التسجيل 46364331-3536-4638-3344-4232FFFFFFFF طبعا كما سبق هذا هو معرف الـ UUID وبعد ان يتم تمريره الى الـ function ToGetAprv ليتم تحويله الى unicode المفروض انه يظهر على الشطل التالى ولكن قمت ببعض التعديلات على الكود الذى يقوم بالتجويل الى الـ unicode بحيث يتم الابقاء على الارقام فقط من دون Chw("") & ولذلك كانت النتيجة كالاتى 525451545251514945515351544552545156455151525245525051507070707070707070 ولذلك فان ال Public Function ChkApprovedNo() As Boolean If DLookup("ApprovedNo", tblUUID) = ToGetAprv(GetUUID()) Then ChkApprovedNo = True End Function يقوم بالوصول الى الرقم ذلك وان كان يساوى الرقم الذى يتم عمل لصق له فى نموذج التسجيل يتم فتح النموذج الرئيسي 8- الكود الاخير لاخر روتين فى الموديول يقوم بعمل كل ماسبق يتأكد من وجود الجدول لو مش موجود ينشئ الجدول ولو الجدول موجود يتأكد من عدد السجلات لو 0 سجل يتم انشاء سجل ويضع به رقم UUID فى الحقل الخاص به ولو السجلات تساوى 1 يقوم بالتأكد من قيمة رقم UUID ان كان المكتوب فى الجدول = الخاص بهذا الجاز يكمل باقى الخطوات والا يوقم بعمل تحديث له للرقم فى الحقل داخل الجدول بما يساوى رقم رقم UUID للجهاز وبعد ذلك يتم تحويل الـ رقم UUID الى unicode مع االبقاء على الرقام فقط ويتأكد من تلك القيمة فى الحقل الخاص بها للتأكد فان كانت يتم فتح النموذج الرئيسي والا يعود الى نموذج التسجيل ولذلك هذا هو المستخدم فى الحدث عند الفتح ويمكن وضعه بنموذج البدء بسهولة من خلال اسمه ChckUUID , او Call ChckUUID بس خلاص Public Function ChckUUID() If ifTableExists(tblUUID) Then Else: CrtTblUUID If DLookup("UUIDPC", tblUUID) <> GetUUID Then DoCmd.SetWarnings False: DoCmd.RunSQL "UPDATE UsysSecured SET UsysSecured.UUIDPC = GetUUID();": DoCmd.SetWarnings True DoEvents If CountRec() Then If DLookup("UUIDPC", tblUUID) = GetUUID Then If ChkApprovedNo Then _ DoCmd.Close acForm, _ Chrw("70") & Chrw("114") & Chrw("109") & Chrw("78") & Chrw("111") & Chrw("116") & Chrw("82") & Chrw("101") & Chrw("103") _ : DoCmd.OpenForm Chrw("70") & Chrw("114") & Chrw("109") & Chrw("77") & Chrw("97") & Chrw("105") & Chrw("110"), , , , , acDialog _ Else: DoCloseForms: DoCmd.OpenForm Chrw( _ "70") & Chrw("114") & Chrw("109") & Chrw("78") & Chrw("111") & Chrw("116") & Chrw("82") & Chrw("101") & Chrw("103"), , , , , acDialog Exit Function End If Else DoCmd.SetWarnings False: DoCmd.RunSQL "INSERT INTO UsysSecured ( UUIDPC ) SELECT GetUUID() AS UUID;": DoCmd.SetWarnings True End If End Function بس ممكن بدل الذهاب الى نموذج التسجيل اغلاق القاعدة نهائيا لمن يريد وطبعا للوصول للحماية القصوى وضع كلمة مرور على محرر الاكواد وكلمة سر لتشفير قاعدة البيانات عند الفتح واغلاق الشيفت واخفاء الاطار وعمل قاعدة ريموت لتمرر كلمة المرور الى القاعدة الحالية عند فتحها وطبعا تلك القاعدة سوف يتم تحويلها الى accde وهذا ما سوف اطرحه لاحقا بس الان انا متعب ملاحظة تم تعديل المرفق الرئيسي بالتعديل الأخير الذى تم تدارك الاخطاء به وسوف يتم حذف كل المرفقات بالموضوع تخفيفا على سيرفر المنتدى اجمل الامانى بكده ينتهى موضوع العبث ويتم تأمين القاعدة بأقصى درجات الأمان لمن يريد

الف شكر لكم ولسعيكم على حل المشكلات التى تواجهنا

Thanks a lot my bro Hassona for your reply that explains the correct steps

تفضل 🙂 المرفق فيه ملفين ، والاثنين يعملون نفس العمل ، ولكن الملف رقم 2 عملته خصيصا لـ @Moosak لأنه يعمل كوحدة نمطية 🙂 الفكرة مثل اول مشاركة ، نعمل حقل مؤقت : . ثم عملت تنسيق شرطي لجميع الحقول ، اذا كانت قيمة الحقل "رقم_التذكرة" موجودة في قيمة الحقل المؤقت ، اجعل لون السطر أخضر (والسبب في اختيار حقل رقم_التذكرة ، لأن بياناته غير متكرر) : 1. نختار جميع الحقول ، 2. ننقر على زر التنسيق الشرطي . . هذه هي المعادلة بالطريقة الصحيحة: InStr([tmp_ticket_No],"|" & [رقم_التذكرة] & "|")>0 . وهذا هو الكود Private Sub Form_Current() Me.tmp_ticket_No = "|" & Me.[رقم_التذكرة] & "|" End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Me.SelHeight = to specify or determine the number of selected rows 'Me.SelTop = to specify or determine which row (record) is topmost in the current selection ' if no selection If Me.SelHeight = 0 Then Exit Sub Dim i As Integer Dim rst As dao.Recordset Set rst = Me.RecordsetClone rst.MoveFirst ' if the user pressed the Shift or Control key on the keyboard, 'then don't clear the previous selection If Shift <> acShiftMask And Shift <> acCtrlMask Then 'clear the previous selection Me.tmp_ticket_No = "" End If ' Move to the first selected record. rst.Move Me.SelTop - 1 ' Loop through the selected records For i = 1 To Me.SelHeight ' add the selected Records to the tmp field Me.tmp_ticket_No = Me.tmp_ticket_No & "|" & rst![رقم_التذكرة] & "|" rst.MoveNext Next i rst.Close: Set rst = Nothing 'Debug.Print Me.tmp_ticket_No End Sub . والنتيجة جعفر 1457.تلوين سجل محدد.accdb (2).zip

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

السلام عليكم ورحمة الله وبركاته بناء على طلب احد الاحباب هذا العمل للتجربة اولا برجاء فتح القاعدة وموافتى بالاتى هل تم فتح القاعدة بشكل طبيعى أم أنه طلب منكم وضع رقم ترخيص لتشغيل القاعدة طيب فى حالة طلب رقم الترخيص من فضلك انسخ رقم الـ Activation Number من النموذج من خلال زر الامر Copy وقم بلصقه هنا فى مشاركة للتأكد من فاعلية الفكرة سوف أرسل لكم رقم ترخيص License Number لفتح القاعدة وبعد ذلك سوف تعمل بنجاح الى ان يتم نقلها لجهاز اخر وستتوقف عن العمل ولن يتم فتحها بنفس الرقم السابق والذى أرسلته اليكم ملاحظة رقم الترخيص يتغير من جهاز لاخر يعنى الشخص الذى سوف ارسل لع رقم الترخيص يخص جهازه الحالى فقط ولن ينفع مع شخص غيره ممكن نجرب سويا Anti Copy 3.zip

جزاك الله خيرا اخى واستاذى @ابو جودي على هذا الشرح الرائع 💐 والف سلامه عليك 🌹 تقبل تحياتى ومرورى

لاحظ الصور حتى تفهم كيف تمت العملية .... New Microsoft Access Database (1).accdb

طيب رجاء فك ضغط الملف المرفق فى الرابط الاتى وقم بالتجربة واخبرنى ان عملت معك المفروض انها تعمل مع كل من mp3 , wav 1142117426_api_PlayMusic.zip

جرب هذه المعادلة في الاستعلام: d: Format(DateAdd("s",[Date_in],#01-01-1970#),"yyyy-mm-dd hh:nn:ss ampm") بس غيّر اسم الحقل من Date_in الى الاسم الحقيقي 🙂 جعفر

تقريبا وصلنا لنتيجة ، ولكن محتاج الى التالي لوسمحت 🙂 اريد ان اعرف التالي: اريدك تدخل معلومة جديدة في الجدول ، تأخذ الوقت الذي يعطيك (كما في الصورة اعلاه) ، واريد ان تكتب التاريخ والوقت بالثانية (هاي تأخذها من ساعتك او ساعة الكمبيوتر ، ومو مهم ان الثواني تكون بالضبط 100%) ، اريد معرفة منطقة السيرفر (الجهاز الذي عليه قاعدة البيانات) : . . وياريت تُدخل مجموعة سجلات فيها اوقات مختلفة 🙂 جعفر

ماشاء الله .. اشتغل ياريت تشرح لنا الموضوع استاذ @ابو جودي في السابق لم اهتم لتلك الامور .. لكن الملف جميل واتمنى معرفة ما يحصل

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

جربت الاول واخبرنى انه خطا والثانى تمام

فتحت المرفق فالبدايه خالص عادى ولم استخدم الشفت او غيره وتم فتحه عادى ولم يتم اظهار اى نموذج اساسا ولما فتحت FrmMain فتح عادى ولم يتم تحويلى الى ان دخلت عالوحده النمطيه وتتبعت الكود ووصلت للجدول وقمت باظهاره وحذفته وشغلت FrmMain مره اخرى فقام بانشاء الجدول والتحويل للنموذج FrmNotReg وهذا الرقم 4C4C4544-0047-3710-8036-B8C04F474831

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

اخى العزيز @ابو جودي جدول UsysSecured موجود بالقاعده ولم حذفته وقمت بتشغيل فورم FrmMain قام بالتحويل للنموذج FrmNotReg بالتوفيق اخى واستاذى

وجرب هذه الطريقة التي تدمج بين isNull و ""= if len(me.combobox1 & "")=0 then me.textbox.enable = false else me.textbox.enable = true end if جعفر

او الملف الذي تريد انشاء جدول وبه حقل محسوب قديم اي تم اصدارة بالكسس قديم .... افتح الملف وحاول حفظة مرة اخرى بالتنسيق الخاص بالاكسس 2010

وعليكم السلام...فتحت بشكل طبيعي

وعليكم السلام ورحمة الله وبركاته 🙂 انا فتحت عندي قاعدة البيانات ، وبدون ان ارى اي نموذج مفتوح ولا اي رسالة 🙂 جعفر

رجاء حذف الوحدة النمطية mod_Shell_n_Wait في برنامجك ، واستبدالها بالمرفقة ، فقد تم تعديلها للعمل على النواتين 32بت و 64بت : Option Compare Database Option Explicit 'https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell%20%26%20Wait%20v2/modShellWait.bas 'http://www.vbforums.com/showthread.php?700373-VB6-Shell-amp-Wait&p=4288285&viewfull=1#post4288285 'Save as "modShellWait" 'Attribute VB_Name = "modShellWait" '======================================================================================================================= '----------------------------------------------- C O N S T A N T S ----------------------------------------------- '======================================================================================================================= Public Const INFINITE As Long = &HFFFFFFFF 'Infinite timeout. Pass INFINITE to ShellW to wait 'indefinitely until the process terminates. Private Const STATUS_PENDING As Long = &H103& '259 Public Const STILL_ACTIVE As Long = STATUS_PENDING Public Const USER_TIMER_MINIMUM As Long = &HA& 'If uElapse is less than USER_TIMER_MINIMUM (0x0000000A), 'the timeout is set to USER_TIMER_MINIMUM. Public Const USER_TIMER_MAXIMUM As Long = &H7FFFFFFF 'If uElapse is greater than USER_TIMER_MAXIMUM (0x7FFFFFFF), 'the timeout is set to USER_TIMER_MAXIMUM. Public Const PROCESS_HAS_TERMINATED As Long = vbObjectError Or &HDEAD& 'Value of Err.Number if process has terminated. '======================================================================================================================= '-------------------------------------------- E N U M E R A T I O N S -------------------------------------------- '======================================================================================================================= '======================================================================================================================= Private Enum BOOL FALSE_ TRUE_ End Enum 'To use, type Ctrl+Space to Complete Word #If False Then Dim FALSE_, TRUE_ #End If '======================================================================================================================= '======================================================================================================================= Private Enum SEE_Mask SEE_MASK_DEFAULT = &H0 'Use default values. SEE_MASK_CLASSNAME = &H1 'Use the class name given by the lpClass member. If both SEE_MASK_CLASSKEY 'and SEE_MASK_CLASSNAME are set, the class key is used. SEE_MASK_CLASSKEY = &H3 'Use the class key given by the hkeyClass member. If both SEE_MASK_CLASSKEY 'and SEE_MASK_CLASSNAME are set, the class key is used. SEE_MASK_IDLIST = &H4 'Use the item identifier list given by the lpIDList member. The lpIDList 'member must point to an ITEMIDLIST structure. SEE_MASK_INVOKEIDLIST = &HC 'Use the IContextMenu interface of the selected item's shortcut menu handler. 'Use either lpFile to identify the item by its file system path or lpIDList 'to identify the item by its PIDL. This flag allows applications to use 'ShellExecuteEx to invoke verbs from shortcut menu extensions instead of the 'static verbs listed in the registry. 'Note: SEE_MASK_INVOKEIDLIST overrides and implies SEE_MASK_IDLIST. SEE_MASK_ICON = &H10 'Use the icon given by the hIcon member. This flag cannot be combined with 'SEE_MASK_HMONITOR. 'Note: This flag is used only in Windows XP and earlier. It is ignored as 'of Windows Vista. SEE_MASK_HOTKEY = &H20 'Use the keyboard shortcut given by the dwHotKey member. SEE_MASK_NOCLOSEPROCESS = &H40 'Use to indicate that the hProcess member receives the process handle. This 'handle is typically used to allow an application to find out when a process 'created with ShellExecuteEx terminates. In some cases, such as when 'execution is satisfied through a DDE conversation, no handle will be 'returned. The calling application is responsible for closing the handle 'when it is no longer needed. SEE_MASK_CONNECTNETDRV = &H80 'Validate the share and connect to a drive letter. This enables reconnection 'of disconnected network drives. The lpFile member is a UNC path of a file 'on a network. SEE_MASK_NOASYNC = &H100 'Wait for the execute operation to complete before returning. This flag 'should be used by callers that are using ShellExecute forms that might 'result in an async activation, for example DDE, and create a process that 'might be run on a background thread. (Note: ShellExecuteEx runs on a 'background thread by default if the caller's threading model is not 'Apartment.) Calls to ShellExecuteEx from processes already running on 'background threads should always pass this flag. Also, applications that 'exit immediately after calling ShellExecuteEx should specify this flag. 'If the execute operation is performed on a background thread and the caller 'did not specify the SEE_MASK_ASYNCOK flag, then the calling thread waits 'until the new process has started before returning. This typically means 'that either CreateProcess has been called, the DDE communication has 'completed, or that the custom execution delegate has notified 'ShellExecuteEx that it is done. If the SEE_MASK_WAITFORINPUTIDLE flag is 'specified, then ShellExecuteEx calls WaitForInputIdle and waits for the new 'process to idle before returning, with a maximum timeout of 1 minute. 'For further discussion on when this flag is necessary, see the Remarks 'section. SEE_MASK_FLAG_DDEWAIT = &H100 'Do not use; use SEE_MASK_NOASYNC instead. SEE_MASK_DOENVSUBST = &H200 'Expand any environment variables specified in the string given by the 'lpDirectory or lpFile member. SEE_MASK_FLAG_NO_UI = &H400 'Do not display an error message box if an error occurs. SEE_MASK_UNICODE = &H4000 'Use this flag to indicate a Unicode application. SEE_MASK_NO_CONSOLE = &H8000& 'Use to inherit the parent's console for the new process instead of having 'it create a new console. It is the opposite of using a CREATE_NEW_CONSOLE 'flag with CreateProcess. SEE_MASK_ASYNCOK = &H100000 'The execution can be performed on a background thread and the call should 'return immediately without waiting for the background thread to finish. 'Note that in certain cases ShellExecuteEx ignores this flag and waits for 'the process to finish before returning. SEE_MASK_HMONITOR = &H200000 'Use this flag when specifying a monitor on multi-monitor systems. The 'monitor is specified in the hMonitor member. This flag cannot be combined 'with SEE_MASK_ICON. SEE_MASK_NOZONECHECKS = &H800000 'Introduced in Windows XP. Do not perform a zone check. This flag allows 'ShellExecuteEx to bypass zone checking put into place by IAttachmentExecute. SEE_MASK_NOQUERYCLASSSTORE = &H1000000 'Not used. SEE_MASK_WAITFORINPUTIDLE = &H2000000 'After the new process is created, wait for the process to become idle 'before returning, with a one minute timeout. See WaitForInputIdle for more 'details. SEE_MASK_FLAG_LOG_USAGE = &H4000000 'Introduced in Windows XP. Keep track of the number of times this 'application has been launched. Applications with sufficiently high counts 'appear in the Start Menu's list of most frequently used programs. SEE_MASK_FLAG_HINST_IS_SITE = &H8000000 'Introduced in Windows 8. The hInstApp member is used to specify the 'IUnknown of the object that will be used as a site pointer. The site 'pointer is used to provide services to the ShellExecute function, the 'handler binding process, and invoked verb handlers. End Enum #If False Then 'http://msdn.microsoft.com/en-us/library/bb759784(v=vs.85).aspx Dim SEE_MASK_DEFAULT, SEE_MASK_CLASSNAME, SEE_MASK_CLASSKEY, SEE_MASK_IDLIST, SEE_MASK_INVOKEIDLIST, _ SEE_MASK_ICON, SEE_MASK_HOTKEY, SEE_MASK_NOCLOSEPROCESS, SEE_MASK_CONNECTNETDRV, SEE_MASK_NOASYNC, _ SEE_MASK_FLAG_DDEWAIT, SEE_MASK_DOENVSUBST, SEE_MASK_FLAG_NO_UI, SEE_MASK_UNICODE, SEE_MASK_NO_CONSOLE, _ SEE_MASK_ASYNCOK, SEE_MASK_HMONITOR, SEE_MASK_NOZONECHECKS, SEE_MASK_NOQUERYCLASSSTORE, _ SEE_MASK_WAITFORINPUTIDLE, SEE_MASK_FLAG_LOG_USAGE, SEE_MASK_FLAG_HINST_IS_SITE #End If '======================================================================================================================= '======================================================================================================================= Private Enum E_ShowCmd SW_HIDE = 0 'Hides the window and activates another window. SW_SHOWNORMAL = 1 'Activates and displays a window. If the window is minimized or maximized, Windows restores 'it to its original size and position. An application should specify this flag when 'displaying the window for the first time. SW_SHOWMINIMIZED = 2 'Activates the window and displays it as a minimized window. SW_SHOWMAXIMIZED = 3 'Activates the window and displays it as a maximized window. SW_MAXIMIZE = 3 'Maximizes the specified window. SW_SHOWNOACTIVATE = 4 'Displays a window in its most recent size and position. The active window remains active. SW_SHOW = 5 'Activates the window and displays it in its current size and position. SW_MINIMIZE = 6 'Minimizes the specified window and activates the next top-level window in the z-order. SW_SHOWMINNOACTIVE = 7 'Displays the window as a minimized window. The active window remains active. SW_SHOWNA = 8 'Displays the window in its current state. The active window remains active. SW_RESTORE = 9 'Activates and displays the window. If the window is minimized or maximized, Windows restores 'it to its original size and position. An application should specify this flag when restoring 'a minimized window. SW_SHOWDEFAULT = 10 'Sets the show state based on the SW_ flag specified in the STARTUPINFO structure passed to 'the CreateProcess function by the program that started the application. An application 'should call ShowWindow with this flag to set the initial show state of its main window. End Enum #If False Then 'http://msdn.microsoft.com/en-us/library/bb762153(v=vs.85).aspx Dim SW_HIDE, SW_SHOWNORMAL, SW_SHOWMINIMIZED, SW_SHOWMAXIMIZED, SW_MAXIMIZE, SW_SHOWNOACTIVATE, _ SW_SHOW, SW_MINIMIZE, SW_SHOWMINNOACTIVE, SW_SHOWNA, SW_RESTORE, SW_SHOWDEFAULT #End If '======================================================================================================================= '======================================================================================================================= Public Enum AppWinStyle 'WindowStyle constants for ShellW vbHide = SW_HIDE vbShowNormal = SW_SHOWNORMAL vbShowMinimized = SW_SHOWMINIMIZED vbShowMaximized = SW_SHOWMAXIMIZED vbMaximize = SW_MAXIMIZE vbShowNoActivate = SW_SHOWNOACTIVATE vbShow = SW_SHOW vbMinimize = SW_MINIMIZE vbShowMinNoActive = SW_SHOWMINNOACTIVE vbShowNA = SW_SHOWNA vbRestore = SW_RESTORE vbShowDefault = SW_SHOWDEFAULT End Enum #If False Then Dim vbHide, vbShowNormal, vbShowMinimized, vbShowMaximized, vbMaximize, vbShowNoActivate, _ vbShow, vbMinimize, vbShowMinNoActive, vbShowNA, vbRestore, vbShowDefault #End If '======================================================================================================================= '======================================================================================================================= '--------------------------------------- T Y P E D E C L A R A T I O N S --------------------------------------- '======================================================================================================================= '======================================================================================================================= Private Type SHELLEXECUTEINFO 'Contains information used by ShellExecuteEx. cbSize As Long 'Required. The size of this structure, in bytes. fMask As SEE_Mask 'Flags that indicate the content and validity of the other structure members; a 'combination of the following values: (See Enum SEE_Mask above) HWnd As Long 'Optional. A handle to the parent window, used to display any message boxes that the 'system might produce while executing this function. This value can be NULL. lpVerb As String 'A string, referred to as a verb, that specifies the action to be performed. The set of 'available verbs depends on the particular file or folder. Generally, the actions 'available from an object's shortcut menu are available verbs. This parameter can be NULL, 'in which case the default verb is used if available. If not, the "open" verb is used. If 'neither verb is available, the system uses the first verb listed in the registry. The 'following verbs are commonly used: 'edit : Launches an editor and opens the document for editing. If lpFile is not a ' document file, the function will fail. 'explore : Explores the folder specified by lpFile. 'find : Initiates a search starting from the specified directory. 'open : Opens the file specified by the lpFile parameter. The file can be an ' executable file, a document file, or a folder. 'openas : Displays the "Open with" dialog for a file. 'print : Prints the document file specified by lpFile. If lpFile is not a document ' file, the function will fail. 'properties : Displays the file or folder's properties. 'runas : Grants the user the ability to launch an application with different ' credentials. lpFile As String 'The address of a null-terminated string that specifies the name of the file or object on 'which ShellExecuteEx will perform the action specified by the lpVerb parameter. The 'system registry verbs that are supported by the ShellExecuteEx function include "open" 'for executable files and document files and "print" for document files for which a print 'handler has been registered. Other applications might have added Shell verbs through the 'system registry, such as "play" for .avi and .wav files. To specify a Shell namespace 'object, pass the fully qualified parse name and set the SEE_MASK_INVOKEIDLIST flag in the 'fMask parameter. 'Note: If the SEE_MASK_INVOKEIDLIST flag is set, you can use either lpFile or lpIDList to 'identify the item by its file system path or its PIDL respectively. One of the two 'values ? lpFile or lpIDList ? must be set. 'Note: If the path is not included with the name, the current directory is assumed. lpParameters As String 'Optional. The address of a null-terminated string that contains the application 'parameters. The parameters must be separated by spaces. If the lpFile member specifies a 'document file, lpParameters should be NULL. lpDirectory As String 'Optional. The address of a null-terminated string that specifies the name of the working 'directory. If this member is NULL, the current directory is used as the working directory. nShow As E_ShowCmd 'Required. Flags that specify how an application is to be shown when it is opened; one of 'the SW_ values listed for the ShellExecute function. If lpFile specifies a document file, 'the flag is simply passed to the associated application. It is up to the application to 'decide how to handle it. hInstApp As Long 'If SEE_MASK_NOCLOSEPROCESS is set and the ShellExecuteEx call succeeds, it sets this 'member to a value greater than 32. If the function fails, it is set to an SE_ERR_XXX 'error value that indicates the cause of the failure. Although hInstApp is declared as an 'HINSTANCE for compatibility with 16-bit Windows applications, it is not a true HINSTANCE. 'It can be cast only to an int and compared to either 32 or the following SE_ERR_XXX error 'codes. lpIDList As Long 'The address of an absolute ITEMIDLIST structure (PCIDLIST_ABSOLUTE) to contain an item 'identifier list that uniquely identifies the file to execute. This member is ignored if 'the fMask member does not include SEE_MASK_IDLIST or SEE_MASK_INVOKEIDLIST. lpClass As String 'The address of a null-terminated string that specifies the name of a file type or a GUID. 'This member is ignored if fMask does not include SEE_MASK_CLASSNAME. hkeyClass As Long 'A handle to the registry key for the file type. The access rights for this registry key 'should be set to KEY_READ. This member is ignored if fMask does not include 'SEE_MASK_CLASSKEY. dwHotKey As Long 'A keyboard shortcut to associate with the application. The low-order word is the virtual 'key code, and the high-order word is a modifier flag (HOTKEYF_). For a list of modifier 'flags, see the description of the WM_SETHOTKEY message. This member is ignored if fMask 'does not include SEE_MASK_HOTKEY. #If True Then hIcon As Long 'A handle to the icon for the file type. This member is ignored if fMask does not include 'SEE_MASK_ICON. This value is used only in Windows XP and earlier. It is ignored as of 'Windows Vista. #Else hMonitor As Long 'A handle to the monitor upon which the document is to be displayed. This member is 'ignored if fMask does not include SEE_MASK_HMONITOR. #End If hProcess As Long 'A handle to the newly started application. This member is set on return and is always 'NULL unless fMask is set to SEE_MASK_NOCLOSEPROCESS. Even if fMask is set to 'SEE_MASK_NOCLOSEPROCESS, hProcess will be NULL if no process was launched. For example, 'if a document to be launched is a URL and an instance of Internet Explorer is already 'running, it will display the document. No new process is launched, and hProcess will be 'NULL. 'Note: ShellExecuteEx does not always return an hProcess, even if a process is launched 'as the result of the call. For example, an hProcess does not return when you use 'SEE_MASK_INVOKEIDLIST to invoke IContextMenu. 'Remarks -------------------------------------------------------------------------------- 'The SEE_MASK_NOASYNC flag must be specified if the thread calling ShellExecuteEx does not 'have a message loop or if the thread or process will terminate soon after ShellExecuteEx 'returns. Under such conditions, the calling thread will not be available to complete the 'DDE conversation, so it is important that ShellExecuteEx complete the conversation before 'returning control to the calling application. Failure to complete the conversation can 'result in an unsuccessful launch of the document. 'If the calling thread has a message loop and will exist for some time after the call to 'ShellExecuteEx returns, the SEE_MASK_NOASYNC flag is optional. If the flag is omitted, 'the calling thread's message pump will be used to complete the DDE conversation. The 'calling application regains control sooner, since the DDE conversation can be completed 'in the background. 'When populating the most frequently used program list using the SEE_MASK_FLAG_LOG_USAGE 'flag in fMask, counts are made differently for the classic and Windows XP-style Start 'menus. The classic style menu only counts hits to the shortcuts in the Program menu. The 'Windows XP-style menu counts both hits to the shortcuts in the Program menu and hits to 'those shortcuts' targets outside of the Program menu. Therefore, setting lpFile to 'myfile.exe would affect the count for the Windows XP-style menu regardless of whether 'that file was launched directly or through a shortcut. The classic style ? which would 'require lpFile to contain a .lnk file name ? would not be affected. 'To include double quotation marks in lpParameters, enclose each mark in a pair of 'quotation marks, as in the following example. ' sei.lpParameters = "An example: \"\"\"quoted text\"\"\""; 'In this case, the application receives three parameters: An, example:, and "quoted text". 'Minimum supported client: Windows XP End Type 'http://msdn.microsoft.com/en-us/library/bb759784(v=vs.85).aspx '======================================================================================================================= '======================================================================================================================= '---------------------------------------- A P I D E C L A R A T I O N S ---------------------------------------- '======================================================================================================================= #If VBA7 And Win64 Then 'Used only by Shell_n_Wait Private Declare PtrSafe Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As BOOL, ByVal dwProcessId As Long) As Long 'Used by both Shell_n_Wait and ShellW Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As BOOL Private Declare PtrSafe Function ExpandEnvironmentStringsW Lib "kernel32.dll" (ByVal lpSrc As LongPtr, Optional ByVal lpDst As LongPtr, Optional ByVal nSize As Long) As Long Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As LongPtr, ByRef lpExitCode As Long) As BOOL Private Declare PtrSafe Function MsgWaitForMultipleObjects Lib "User32.dll" (ByVal nCount As Long, ByRef pHandles As LongPtr, ByVal bWaitAll As BOOL, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long Private Declare PtrSafe Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr, Optional ByVal Length As Long) As Long 'Used by ShellW Private Declare PtrSafe Function CreateWaitableTimerW Lib "kernel32.dll" (Optional ByVal lpTimerAttributes As Long, Optional ByVal bManualReset As BOOL, Optional ByVal lpTimerName As Long) As Long Private Declare PtrSafe Function GetProcessId Lib "kernel32.dll" (ByVal hProcess As Long) As Long Private Declare PtrSafe Function PathCanonicalizeW Lib "shlwapi.dll" (ByVal lpszDst As LongPtr, ByVal lpszSrc As LongPtr) As BOOL Private Declare PtrSafe Function PathGetArgsW Lib "shlwapi.dll" (ByVal pszPath As LongPtr) As Long Private Declare PtrSafe Function SetWaitableTimer Lib "kernel32.dll" (ByVal hTimer As Long, ByRef pDueTime As Currency, Optional ByVal lPeriod As Long, Optional ByVal pfnCompletionRoutine As Long, Optional ByVal lpArgToCompletionRoutine As Long, Optional ByVal fResume As BOOL) As BOOL Private Declare PtrSafe Function ShellExecuteExW Lib "shell32.dll" (ByVal pExecInfo As LongPtr) As BOOL Private Declare PtrSafe Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long Private Declare PtrSafe Sub PathRemoveArgsW Lib "shlwapi.dll" (ByVal pszPath As LongPtr) Dim hProcess As LongPtr #Else 'Used only by Shell_n_Wait Private Declare PtrSafe Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As BOOL, ByVal dwProcessId As Long) As Long 'Used by both Shell_n_Wait and ShellW Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As BOOL Private Declare PtrSafe Function ExpandEnvironmentStringsW Lib "kernel32.dll" (ByVal lpSrc As Long, Optional ByVal lpDst As Long, Optional ByVal nSize As Long) As Long Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpExitCode As Long) As BOOL Private Declare PtrSafe Function MsgWaitForMultipleObjects Lib "User32.dll" (ByVal nCount As Long, ByRef pHandles As Long, ByVal bWaitAll As BOOL, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long Private Declare PtrSafe Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long 'Used by ShellW Private Declare PtrSafe Function CreateWaitableTimerW Lib "kernel32.dll" (Optional ByVal lpTimerAttributes As Long, Optional ByVal bManualReset As BOOL, Optional ByVal lpTimerName As Long) As Long Private Declare PtrSafe Function GetProcessId Lib "kernel32.dll" (ByVal hProcess As Long) As Long Private Declare PtrSafe Function PathCanonicalizeW Lib "shlwapi.dll" (ByVal lpszDst As Long, ByVal lpszSrc As Long) As BOOL Private Declare PtrSafe Function PathGetArgsW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long Private Declare PtrSafe Function SetWaitableTimer Lib "kernel32.dll" (ByVal hTimer As Long, ByRef pDueTime As Currency, Optional ByVal lPeriod As Long, Optional ByVal pfnCompletionRoutine As Long, Optional ByVal lpArgToCompletionRoutine As Long, Optional ByVal fResume As BOOL) As BOOL Private Declare PtrSafe Function ShellExecuteExW Lib "shell32.dll" (ByVal pExecInfo As Long) As BOOL Private Declare PtrSafe Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long Private Declare PtrSafe Sub PathRemoveArgsW Lib "shlwapi.dll" (ByVal pszPath As Long) Dim hProcess As Long #End If '======================================================================================================================= '---------------------------------------- G L O B A L V A R I A B L E S ---------------------------------------- '======================================================================================================================= Public g_ExitDoLoops As Boolean 'Remember to set this to True just before program termination to ensure all 'Do...Loops in this module exits normally in case they are still running '======================================================================================================================= '--------------------------------------- P R I V A T E V A R I A B L E S --------------------------------------- '======================================================================================================================= Private m_Busy1 As Boolean 'Busy flag for Shell_n_Wait Private m_Busy2 As Boolean 'Busy flag for ShellW '======================================================================================================================= '------------------------------------------ P U B L I C M E T H O D S ------------------------------------------ '======================================================================================================================= 'Extends the native Shell function by waiting for the shelled program's termination without blocking other events. Public Function Shell_n_Wait(ByRef PathName As String, Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus) As Long Const PROCESS_QUERY_INFORMATION = &H400&, QS_ALLINPUT = &H4FF&, SYNCHRONIZE = &H100000 Dim sPath As String If Not m_Busy1 Then m_Busy1 = True Else Exit Function 'Only 1 instance of this function at a time is allowed If InStr(PathName, "%") = 0& Then 'Check if there are environment variables that needs to be expanded sPath = PathName Else SysReAllocStringLen VarPtr(sPath), , ExpandEnvironmentStringsW(StrPtr(PathName)) - 1& ExpandEnvironmentStringsW StrPtr(PathName), StrPtr(sPath), Len(sPath) + 1& End If On Error GoTo 1 'Shell the specified executable file and get a handle to its process hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or SYNCHRONIZE, FALSE_, Shell(sPath, WindowStyle)) On Error GoTo 0 If hProcess Then sPath = vbNullString g_ExitDoLoops = False Do While MsgWaitForMultipleObjects(1&, hProcess, FALSE_, INFINITE, QS_ALLINPUT) DoEvents 'MWFMO returns when either the process ends or an input arrives. If g_ExitDoLoops Then Exit Do 'It returns 1& (WAIT_OBJECT_0 + nCount) for an input Loop 'and 0& (WAIT_OBJECT_0 + nCount - 1&) for a process. 'Return the exit code of the terminated program (usually 0; STILL_ACTIVE (259) if still running) WindowStyle = GetExitCodeProcess(hProcess, Shell_n_Wait): Debug.Assert WindowStyle 'If code stops here, the hProcess = CloseHandle(hProcess): Debug.Assert hProcess 'handle(s) weren't closed End If m_Busy1 = False Exit Function 1 m_Busy1 = False 'Always reset the busy flag Err.Raise Err 'If Shell failed, propagate the error to the caller to End Function 'help distinguish its failure from a return value of 0 'Launches an executable file or registered file type; optionally waits for the specified duration before returning. Public Function ShellW(ByRef PathName As String, Optional ByVal WindowStyle As AppWinStyle = vbShowNormal, _ Optional ByVal Wait As Long) As Long Const MAX_PATH = 260&, QS_ALLINPUT = &H4FF&, WAIT_OBJECT_0 = &H0& Dim TimedOut As Boolean, nCount As Long, pHandles As LongPtr, RV As Long, SEI As SHELLEXECUTEINFO Err.Clear 'Reset Err object every time this function is called If m_Busy2 Then Exit Function 'This function shouldn't be called more than once at any given time If LenB(PathName) Then m_Busy2 = True _ Else Exit Function 'See if there's anything to do With SEI .cbSize = LenB(SEI) .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_DOENVSUBST Or SEE_MASK_FLAG_NO_UI 'Suppress error message .nShow = WindowStyle '^ Expand environment variables 'boxes by ShellExecuteEx If InStr(PathName, "%") Then 'Expand environment variables, if any SysReAllocStringLen VarPtr(.lpFile), , ExpandEnvironmentStringsW(StrPtr(PathName)) - 1& ExpandEnvironmentStringsW StrPtr(PathName), StrPtr(.lpFile), Len(.lpFile) + 1& Else .lpFile = PathName 'ShellExecuteEx doesn't expand environment variables in .lpParameters End If Select Case True Case InStr(.lpFile, "\.") <> 0&, InStr(.lpFile, ".\") <> 0& 'Look for "\.", "\..", ".\" or "..\" If Len(.lpFile) < MAX_PATH Then SysReAllocStringLen VarPtr(.lpVerb), , MAX_PATH - 1& 'Temporarily use .lpVerb as a buffer If PathCanonicalizeW(StrPtr(.lpVerb), StrPtr(.lpFile)) Then 'Simplify the given path SysReAllocString VarPtr(.lpFile), StrPtr(.lpVerb) 'by removing "." & ".." End If .lpVerb = vbNullString End If End Select SysReAllocString VarPtr(.lpParameters), PathGetArgsW(StrPtr(.lpFile)) 'Separate arguments from the file, if any If LenB(.lpParameters) Then 'If there are, then trim the PathRemoveArgsW StrPtr(.lpFile) 'original arguments from lpFile _ If InStr(.lpParameters, """") Then .lpParameters = Replace(.lpParameters, """", """""""") End If 'MSDN's instructions don't seem to work in XP If ShellExecuteExW(VarPtr(SEI)) Then 'Launch the specified executable or registered file type ShellW = GetProcessId(.hProcess) 'Return the Task ID, a.k.a. Process ID If Wait Then 'If specified, wait Wait milliseconds before returning .lpFile = vbNullString .lpParameters = vbNullString g_ExitDoLoops = False If .hProcess Then nCount = 1& pHandles = VarPtr(.hProcess) End If If Wait > INFINITE Then 'If specified waiting time isn't INFINITE or negative, .hIcon = CreateWaitableTimerW 'then create & set a waitable timer with the given duration If .hIcon Then 'Repurpose the unused .hIcon member as hTimer nCount = nCount + 1& 'and treat it along with .hProcess as a pseudo-array pHandles = VarPtr(.hIcon) Wait = SetWaitableTimer(.hIcon, CCur(-Wait)): Debug.Assert Wait End If '^ Negative values indicate relative time End If 'MWFMO will wait for either process termination, timer expiration or input arrival Do: RV = MsgWaitForMultipleObjects(nCount, ByVal pHandles, FALSE_, INFINITE, QS_ALLINPUT) If RV < nCount Then 'If RV <= WAIT_OBJECT_0 + nCount - 1& Then If .hIcon Then TimedOut = RV = 0& 'If MWFMO returned hTimer's index, then the timer expired RV = CloseHandle(.hIcon): Debug.Assert RV 'If code stops here, the handle wasn't closed End If Err.Clear 'Reset Err (in case it was raised elsewhere) Exit Do 'and break out of the loop End If DoEvents 'Allow the incoming input(s) to be processed Loop Until g_ExitDoLoops If Not (TimedOut Or g_ExitDoLoops) Then 'If the timer hasn't yet expired, then the process has terminated RV = GetExitCodeProcess(.hProcess, ShellW): Debug.Assert RV 'Return the terminated process' exit code Err = PROCESS_HAS_TERMINATED 'Set the Err object's properties instead of raising an error Err.Description = "Exit Code" 'This is similar to the API's use of Get/SetLastError End If End If If .hProcess Then RV = CloseHandle(.hProcess): Debug.Assert RV 'If code stops here, the handle wasn't closed End If End With m_Busy2 = False 'Reset busy flag End Function 'ShellW returns either the Process ID, the Exit Code or zero (check Err.Number to distinguish) 'Runs a program in a new process. Public Function ShellWS(ByRef Command As String, Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus, _ Optional ByVal WaitOnReturn As Boolean) As Long Dim ws As Object Set ws = CreateObject("Wscript.Shell") #Const Referenced = True ShellWS = ws.Run(Command, WindowStyle, WaitOnReturn) 'j #If Not Referenced Then 'j ShellWS = CreateObject("WScript.Shell").Run(Command, WindowStyle, WaitOnReturn) 'j #Else 'j With New WshShell 'j ShellWS = .Run(Command, WindowStyle, WaitOnReturn) 'j End With 'j #End If 'Adapted from "Best Shell & Wait (No API's!)" by Matthew Roberts End Function 'http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=8349&lngWId=1 جعفر Shell_n_Wait_2021-12-13.txt.zip

عليكم السلام عسى يكون المطلوب زر طباعة1.xlsm

شكرا جزيلا اخوي عمرو 🙂 استخدم كلام الدكتور حسنين @SEMO.Pa3x واخي الاستاذ خالد @kha9009lid (أسأل الله سبحانه وتعالى ان نشوفهم في المنتدى عاجلا غير آجل) انه لا يوجد شيء اسمه حماية مطلقة في جميع البرامج (طبعا ممكن تكون هناك حالات خاصة) وليس في الاكسس فقط . فمثلا ، كثر تداول التحدث انه يمكن تحويل الاكسس صيغة accde الى مصدر مفتوح accdb ، ولكني لم اجد سوى موقع واحد في الانترنت لأحد محترفي الاكسس ، ومكتوب في صفحته انه الجهة الوحيدة التي تستطيع القيام بذلك على مستوى العالم: The only service worldwide وهذه الخدمة بمقابل ولا يوجد برنامج يمكن نشتريه لهذا الغرض او نجد له كراك ، والموقع يطلب منك الكثير من التوثيقات للتأكد انه برنامجك ، ثم يقوم لإسترجاع برنامجك. بمعنى آخر ، ان الاكسس بأمان اكثر من اي برنامج آخر ، فلا تستطيع تحويله من accde او accdb ، لأن بقية البرنامج ، توجد في الانترنت برامج تفكها 😁 وحتى البرنامج الذي تفضلت به وارفقت نسخة منه ، فلم اكن اعلم عنه ، لأنه لم يكن يهمني ، فلم اكن افكك برامج setup 🙂 نعم ، نجتهد قدر المستطاع لحمايته ، والطريقة التي تفضلتم بها ، احدها 🙂 في الواقع هذا الموضوع اصبح اجمل كثيرا بهذه المشاركات ، شكرا لكم جميعا 🙂 جعفر

عن طريق هذا البرنامج مثلا : https://github.com/Bioruebe/UniExtract2#download والنتيجة فى المرفقات وأثناء التثبيت يظهر ايضا الفولدر ويمكن أخذ كوبى من محتوياته بس فى النهاية كمستخدم عادى او كعميل لن تستطيع الوصول لهذه النتيجة الا لو كان عندك خلفية عن هذه الامور. SetupExtracted.rar

هذا هو التطبيق الذى تتحدث عنه استاذنا..

وفي الانتظار ، وعلى احر من الجمر 🙂 جعفر

فى الانتظار

لا شكر على واجب تشرفت بمرورك

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

السلام عليكم ورحمة الله وبركاته اخى الرابط في اول الموضوع list all files and folders in path.rar

شكر وتقدير واحترام من اخيك استاذى الفاضل

تفضل .. ها هي قاعدة البيانات وهل تعرف ما هذا : Mf}*019084/ImOe@|$<n LangData.accdb

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

وهذا محور النقاش منذ بداية الموضوع وهذا نموذج للفكرة Setup.rar ارجو ان تقومي بالتجربة ومحاولة استخراج الملف الأصلي من الملف المرفق أعني النسخة accdb وهي موجودة بالداخل ولا شك. ملاحظة ارجو تجربة المرفق علي النوتين 32 و 64 وموافاتنا بالنتائج مع العلم أني اعمل علي النوت 32 فقط

جربها بهذا الشكل اخى ضع هذه المعادله في c6 =IF(AND(ISNUMBER('شيت الرابع'!P12);ISNUMBER('شيت الرابع'!Q12));'شيت الرابع'!P12+'شيت الرابع'!Q12;IF(ISNUMBER('شيت الرابع'!P12);'شيت الرابع'!P12;'شيت الرابع'!Q12)) تغير العلامه , الى ;

اخى عمر ضع هذه المعادله =B2&C2 في العامود f في الخليه f2 في المخزن ثم اسحب المعادله الى اخر سطر في اكواد وهو f48 ثم اذهب الى الورقه باسم ورقه ١ ثم ضع الكود الخاص بالاستاذ @lionheart ستجد ان الرساله التى تريدها ستظهر لك ان شاء الله

هذه احد ميزات المنتدى ، الإفادة والاستفادة ، لنا كلنا 🙂 جعفر

همممم يصير مع النماذج: http://allenbrowne.com/ser-35.html والمرفق من الرابط 🙂 جعفر MultiInstance2k.zip

عامة تفضل الحل الذى تريده . الشرح : كما قلت لا يمكن فتح نفس العنصر مرتين ولذلك نحتاج لعمل نسخة طبق الاصل منه كما يلى : Dim x, s As String s = Me.Name x = Me.Name & "NCpy" DoCmd.CopyObject , x, acForm, s DoCmd.OpenForm x الامر السابق سيقوم بنسخ النموذج الذى تم ضغط الزر فيه واضافة NCpy بجوار اسمه . ومطلوب عند الانتهاء حذف النسخ الوهمية التى تم انشاؤها والتى يحتوى اسمها على NCpy ولذلك يتم وضع هذا الحدث عند غلق النموذج On Close Dim obj As AccessObject On Error Resume Next For Each obj In CurrentProject.AllForms If obj.Name Like "*NCpy*" Then Debug.Print "Deleting " & obj.Name DoCmd.Close acForm, obj.Name, acSaveNo DoCmd.DeleteObject acForm, obj.Name End If Next يمكن وضع حدث حذف النموذج فى زر بدلا من عند الغلق لأنه بيقفل كافة النسخ ويحذفها ,, وفى النهاية لا أفضل هذه الطريقة اكيد هناك حلول اخرى للوصول الى الهدف الاساسى . مرفق القاعدة بالتوفيق . so - Amr.accdb

تفضل هذا الجزء من طلبك و مشاركتي مع اخي @Eng.Qassim انشء موديول جديد و الصقي التالي Public Function SetColNumber(SetText As String) As Variant Dim Number1 As Double, Number2 As Double, CulSum As Variant For i = 1 To Len(SetText) If Mid(SetText, i, 1) = "+" Or Mid(SetText, i, 1) = "-" Or _ Mid(SetText, i, 1) = "/" Or Mid(SetText, i, 1) = "*" Then CulSum = Mid(SetText, i, 1) End If Next i Number1 = Split(SetText, CulSum)(0) Number2 = Split(SetText, CulSum)(1) Select Case CulSum Case Is = "-" SetColNumber = Number1 - Number2 Case Is = "+" SetColNumber = Number1 + Number2 Case Is = "*" SetColNumber = Number1 * Number2 Case Is = "/" SetColNumber = Number1 / Number2 End Select End Function و في حدث لمربع النص بعد التحديث الصق التالي tot = SetColNumber(tot) تفضل الملف بعد التعديل 14.accdb

تفضل التعديل الدائن و المدين.zip

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

راح يفتح عندك التقرير بعون الله انا افترضت ان الارقام نصوص.. اما اذا كان نوع الحقل رقم فلاتضع علامتي التنصيص If (Me.accode = "0008") And (Me.in12 = "2") And (Me.NV <> Me.nv2) Then DoCmd.OpenReport "h22", acViewReport End If

احسنت استاذ احمد @الفلاحجى على هذا الكلام الطيب واشهد للاستاذ @سامي الحداد بأنه شخص مبدع رغم تغيبه الكثير😍 والعذر طبعا لاخينا صاحب المشاركة فربما لم ينتبه لذلك سائلين المولى ان يحفضكم جميعا

تفضل التعديل 855.zip

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

=IF(A1<25;"متوسط";IF(A1<30;"جيد";IF(A1<40;"جيد جداً";IF(A1<51;"ممتاز")))) جرب هذه المعادلة البسيطة