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

السلام عليكم بما أنكم لم تحصلوا على الحل بعد إليك هذا الكود، لقد أثار سؤالكم فضولي وبعد البحث توصلت إلى الكود وقمت بتعديله على النحو الذي عمل لدي على جميع البرامج على حاسبي، مع ملاحظة أن ملفكم المرفق لم يعمل على جهازي. قم باستدعاء الأمر التالي بالأحداث: Public Sub MinimizeProgram() وذلك بعد وضع الكود الآتي في مودجال جديد، و الانتباه إلى المعايير والتي هي عبارة عن جزء من اسم التطبيق: criteria = "*CivilIdHtmlDemo*" الكود: Option Compare Database Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, _ ByVal param As Long) As Long Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _ (ByVal hwnd As Long, _ ByVal lpString As String, _ ByVal cch As Long) As Long Public Declare Function fShowWindow Lib "user32.dll" Alias "ShowWindow" _ (ByVal lngHWND As Long, ByVal lngCommand As Long) As Long Dim lngHandle As Long Dim lngTemp As Long Public Const MAX_LEN = 260 ' you can use the Comment if you add (Microsoft Scripting Runtime) Library to the references. Public results 'As Dictionary Public criteria As String Public Sub MinimizeProgram() 'Edited By Hamdi-E 10/9/2020 'Officena Forums Khalf 'put a part Of the Targeted App Name criteria = "*CivilIdHtmlDemo*" Set results = CreateObject("Scripting.Dictionary") ' you can use the Comment if you add (Microsoft Scripting Runtime) Library to the references. ' Set results = New Dictionary Call EnumWindows(AddressOf EnumWindowCallback, &H0) Dim result As Variant For Each result In results.Keys lngTemp = fShowWindow(result, 1) ' the available values in the second parameter: 'vbHide 0 'vbMaximizedFocus 3 'vbMinimizedFocus 2 'vbMinimizedNoFocus 6 'vbNormalFocus 1 'vbNormalNoFocus 4 Next result End Sub Public Function EnumWindowCallback(ByVal hwnd As Long, ByVal param As Long) As Long Dim retValue As Long Dim buffer As String If IsWindowVisible(hwnd) Then buffer = Space$(MAX_LEN) retValue = GetWindowText(hwnd, buffer, Len(buffer)) If retValue Then If buffer Like criteria Then results.Add hwnd, Left$(buffer, retValue) End If End If End If EnumWindowCallback = 1 End Function الحمد لله الذي بنعمته تتم الصالحات، اللهم صلِ على سيدنا محمد وعلى آله وصحبه ومن ولاه وسلم تسليماً كثيراً.

السلام عليكم 🙂 وجرب هذا المرفق. هذا المرفق ينزل جميع البرامج المفتوحة ، وبعدين يكبّر برنامج الاكسس بعد ثانية ، حصلت على الكود من الانترنت ، وتم عمل بعض التعديلات عليه وتضبيطه للعمل على النواتين 32 و 64 بت : Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function PostMessage Lib "USER32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim DoIt As LongPtr #Else Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare PtrSafe Function PostMessage Lib "USER32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim DoIt As Long #End If 'Private Declare PtrSafe Function PostMessage Lib "USER32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Const WM_COMMAND As Long = &H111 Private Const MIN_ALL As Long = 419 Private Const MIN_ALL_UNDO As Long = 416 Private Const SW_RESTORE As Long = 9 ' Public Function Minimize_AllWindows() DoIt = FindWindow("shell_traywnd", vbNullString) 'to minimize them all Call PostMessage(DoIt, WM_COMMAND, MIN_ALL, 0&) Dim PauseTime, Start PauseTime = 1 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop DoCmd.RunCommand acCmdAppMaximize End Function Public Function Restore_AllWindows() DoIt = FindWindow("shell_traywnd", vbNullString) 'to return them all to normal size Call PostMessage(DoIt, WM_COMMAND, MIN_ALL_UNDO, 0&) End Function . وطريقة العمل اننا ننادي الوحدة النمطية عند بدء البرنامج هكذا : call Minimize_AllWindows . وعند اغلاق البرنامج يمكننا ان ننادي الوحدة النمطية الاخرى لإرجاع جميع النوافد مثل ما كانت على قبل الانزال ، هكذا ، call Restore_AllWindows . اما انا ، فأفتح برنامجي عن طريق الماكرو autoexec والذي يعمل تلقائيا لما يفتح الاكسس ، واول امر فيه هو مناداة الوحدة النمطية لتصغير النوافد ، ثم يفتح لي النموذج الذي اريده ، هكذا : . ولما اغلق البرنامج ، اضع كود ارجاع البرامج الى وضعها السابق على حدث زر الخروج من البرنامج : . والكود : Call Restore_AllWindows DoCmd.Quit جعفر All_Minimize_Restore.zip

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

استخدم برنامج تمكين الشفت واعمل مثل الصورة المرفقة البرنامج في المرفقات تمكين الشفت (2020).accdb

اخواني الافاضل تم شرح الخطوات بالصور ليسهل تطبيقها وتجدونها في المرفقات. اولاً اذا كانت قاعدة البيانات باللغة العربية حولها على الانجليزية ، واسهل وسيلة لعرض بيانات قاعدة بيانات SQL Server هي الاكسس و بما اننا نتكلم عن قاعدة بيانات على الاكسس انصح انك تبدء تصمم الواجهات على VB.Net او ASP.Net ، فهي لا تختلف كثيرا عن الاكسس ، لكن المميز فيها بأن المستخدم يستطيع الاستفادة من برنامجك على جميع الاجهزة كمبيوتر - لابتوب-موبايل - ايباد و غيرها ثانيا انشئ حساب على سيرفر SOMEE من : https://somee.com/default.aspx و اختر حزمة الاستضافة المجانية https://somee.com/DOKA/DOC/DOLoginOrRegister.aspx . . . . . عمل قاعدة بيانات SQL Server . . . . . . . برنامجك الاكسس : . . . . . . . . . . . . . . . . . في حال وجود اي استفسارات ارجوا كتابتها في التعليقات نشر قاعدة البيانات.zip

نتعلم منكم يا ابا عبدالله 🌹

اضغط ESC

خير الكلام ما قل ودل 🙂 جعفر

عليك السلام ورحمة الله وبركاته تم عمل شرط لكل عنوان إذا كان فارغ لايتم حساب الكمية × السعر جرب هذا New Microsoft Excel Worksheet.xlsx

وعليكم السلام ورحمة الله وبركاته ممكن نختصر اكواد طويلة ونستخدم الخيارات الموجودة في الاكسيس الفكرة هنا كيف نصل الى نافذة خيارات البرنامج الكود التالي مكون من زرين امر احدهما للتأشير علامة صح امام ضغط واصلاح قاعدة البيانات عد الاغلاق والزر الثاني يعكس العملية ويقوم بازالة علامة صح ايضا واختصارا لعملية كثيرة وانشاء جدول وكتابة اكود يمكن عرض InputBox وتحديد كلمة سر لتنفيذ العملية Private Sub Command0_Click() If InputBox("أدخل الكلمة السرية ", "كلمة سر مطلوبة") <> "123" Then MsgBox " كلمة المرور غير صحيحة", vbInformation, "officena" Else Application.SetOption "Auto compact", True MsgBox " سيتم ضغط واصلاح قاعدة البيانات عند اغلاق البرنامج", vbInformation, "officena" End If End Sub Private Sub Command1_Click() If InputBox("أدخل الكلمة السرية ", "كلمة سر مطلوبة") <> "123" Then MsgBox " كلمة المرور غير صحيحة", vbInformation, "officena" Else Application.SetOption "Auto compact", False MsgBox " تم الغاء ضغط واصلاح قاعدة البيانات عند اغلاق البرنامج", vbInformation, "officena" End If End Sub db9.rar تحياتي

عاشت ايدك استاذ سليم العزيز مشكور جهودك المبذلة ابدعت

تسلم يمينك نصركم الله واعزكم اللهم امين

وعليكم السلام اخوي محمد 🙂 ممكن تجرب هذه النسخة وتخبرنا بالنتيجة لوسمحت ، علشان ارفعها في المشاركة الاولى 🙂 جعفر Decompile_3.zip

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