Moosak

وعليكم السلام ورحمة الله وبركاته 🙂 شكرا لتهانيكم وتبريكاتكم إخواني / آبائي / أساتذتي الأعزاء 🙂 🌹 يكفيني شرفاً ورفعة وجودي بينكم إخواني الأعزاء وما يزيدني هذا المنصب عنكم مقدار درجة ، فأنا منكم وإليكم والسلام عليكم 😅🖐🏼️ والشكر مرفوع للإدارة الكريمة ، والوالد والمهندس والأستاذ العزيز @jjafferr 🙂 نفعني الله بكم ، وأعاننا جميعا على حمل الأمانة 🌹🤲🏼

كلها شغالة وظاهرة معي أستاذي العزيز 🙂 فقط تنبيه بسيط وقمت بعمل تعديل بسيط على الكود : بعد التغيير من false الى true أو العكس إضغط مباشرة على Run ثم أعد التشغيل ويعمل معك بإذن الله ولمزيد فائدة أضفت للملف ماكرو جديد وظيفته أنه يمنع استخدام زر F11 واللي يقوم بإظهار الجداول والنماذج عندما تكون مخفية 🙂 أخي سامر جرب انسخ (نسخ / لصق) الماكرو والموديول اللي معاي عندك .. وإذا ما اشتغلت .. أرفق برنامجك علشان نشوف سبب المشكلة 🙂 AutoExec.accdb

أعد تشغيل البرنامج مرة أخرى .. لأن التشغيل الأول يحتاج لإعادة تشغيل البرنامج لكي يتم تطبيقها بشكل كامل .. ولن تحتاج لإعادة هذه الخطوة في كل مرة .. هي فقط المرة الأولى 🙂 وهذا مثال مرفق يوضح النتيجة وبه الكود والماكرو .. ولتعديل الماكرو ورؤية العناصر إفتح الملف بزر الـ Shift 🙂 << تم نقل المرفق للمشاركة التالية >> https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=216275&key=be0665907152bc7f887f7580f9fc9983

الأستاذ العزيز @ابوخليل جابلك الحل للقاعدة الحالية جزاه الله خيرا .. 🙂 وكمقترح وفكرة لحل هذه القضية .. لما تستورد أي ملف في قاعدة البيانات إحفظ في الجدول الجزء اللي بعد المجلد اللي فيه قاعدة البيانات فقط .. وخلي الكود يكمل لك مسارات الملفات .. وبهذي الطريقة ممكن تنقل البرنامج لأي جهاز ثاني بدون ما تتأثر البيانات في الجدول وما يحتاج تغيرها كل مرة تنقل البرنامج .. توضيح ومثال : مثلا هذا رابط الملف كاملا (مع العلم أن ملف قاعدة البيانات موجود في المجلد الذي باللون الأخضر ): D:\MoosaKDataBase\Files\Id_Folder_564\MyWordFile.docx إحفظ في الجدول الجزء الذي باللون الأحمر فقط : D:\MoosaKDataBase\Files\Id_Folder_564\MyWordFile.docx هكذا : Files\Id_Folder_564\MyWordFile.docx ولما تحتاج تستدعي الملف تخلي هاذا الكود يكمل لك الباقي : CurrentProject.path & "\" & a وسيكون الرابط مكتملا هكذا CurrentProject.path & "\" & Files\Id_Folder_564\MyWordFile.docx وظيفة الكود الذي باللون الأزرق هو إحضار رابط المجلد الذي فيه قاعدة البيانات أينما كانت .. ويتغير بتغير موقعها من جهاز إلى آخر .. وسلامتكم 😉🖐🏼️

وعليكم السلام ورحمة الله وبركاته 🙂 انسخ هذي الدالة عندك في موديول جديد : Public Function ShowHideRibbon(ShowRibbon As Boolean) On Error GoTo ErrHandler '*********************( إخفاء/إظهار الشريط العلوي وجميع النوافذ )************************** If ShowRibbon = False Then '--------------------------------(إخفاء الريبون والنفجيشن بان) DoCmd.ShowToolbar "Ribbon", acToolbarNo ' Hide Navigation Pane: DoCmd.NavigateTo ("acnavigationcategoryobjecttype") DoCmd.RunCommand (acCmdWindowHide) '--------------------------------(جميع تضبيطات تقفيل القاعدة وإخفاء القوائم ومنع الزر الأيمن والاختصارات) Application.SetOption "Show Status Bar", False CurrentDb.Properties("ShowDocumentTabs") = False Application.SetOption "Auto compact", True Application.SetOption "Remove Personal Information", False Application.SetOption "Themed Form Controls", False Application.SetOption "DesignWithData", False CurrentDb.Properties("AllowDatasheetSchema") = False Application.SetOption "CheckTruncatedNumFields", False CurrentDb.Properties("AllowFullMenus") = False CurrentDb.Properties("AllowShortcutMenus") = False ElseIf ShowRibbon = True Then '--------------------------------(إضهار الريبون والنفجيشن بان) DoCmd.ShowToolbar "Ribbon", acToolbarYes 'Unhide the navigation pane On Error Resume Next Call DoCmd.SelectObject(acTable, , True) Call DoCmd.SelectObject(acMacro, , True) Call DoCmd.SelectObject(acForm, , True) On Error GoTo ErrHandler '--------------------------------(فتح خصائص قاعدة البيانات وإظهار القوائم وتفعيل الزر الأيمن والاختصارات) Application.SetOption "Show Status Bar", True CurrentDb.Properties("ShowDocumentTabs") = True Application.SetOption "Auto compact", True Application.SetOption "Remove Personal Information", True Application.SetOption "Themed Form Controls", True Application.SetOption "DesignWithData", True CurrentDb.Properties("AllowDatasheetSchema") = True Application.SetOption "CheckTruncatedNumFields", True CurrentDb.Properties("AllowFullMenus") = True CurrentDb.Properties("AllowShortcutMenus") = True End If '--------------------------------------------------------------------------- ErrHandler: If Err.Number <> 0 Then MsgBox Err.Number & " \\\\\ " & Err.Description, , "Function: ShowHideRibbon" Resume Next Else Exit Function End If End Function هذي الدالة تخفي لك الشريط العلوي والجداول وجميع العناصر وغيرها .. بعدين أعمل ماكرو جديد واحفظة باسم Autoexec ( ضروري التسمية تكون نفسها بالحرف ) افتح الماكرو واعمل فيه أمر RunCode ونادي الدالة هكذا : =ShowHideRibbon(False) وإذا بغيت تغير رايك وتظهر الشريط العلوي وبقية العناصر تغير ال False إلى True ثم تشغل الماكرول بالضغط على RUN وبعدها تعيد تشغيل البرنامج .. << المرفق >> https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=216275&key=be0665907152bc7f887f7580f9fc9983

أنصحك بال #C .. 😊👌🏼 والمنتدى موجود .. بس محتاج تفعيل حبتين https://www.officena.net/ib/forum/183-cnet/

أنا جالس 5 دقايق أدور الفرق وما لقيته 😂 شكله أنطلت علي خدعة الشياب 😁

بالنسبة للكود هو عبارة عن دالة تعطيها نص معين فتحوله إلى شيفرة من رموز غير مفهومة هكذا : والدالة الثانية تعكس ما تفعله الدالةالأولى .. بحيث تعطيها النص المشفر فترجعه إلى أصله .. هكذا : وعليه ممكن تستخدمي الدالة كوسيط بين نموذج الإدخال والأكواد اللي تحفظ البيانات في الجدول ( تشفير ... وفك التشفير ) .. وهكذا

أنا أتيت بنصف الجواب .. أما موضوع المدة التجريبية فما اشتغلت فيه سابقا 😅🖐🏼️

وعليكم السلام ورحمة الله وبركاته 🙂 من مكتبتي .. هذه دالتان الأولى لتشفير البيانات والثانية لفك التشفير .. أخذتهما من أحد البرامج الخاصة بأستاذنا العزيز @ابو جودي أزال الله أتراحه وأدام الله أفراحه .. Option Compare Database Option Explicit 'ExxE=Encrypt 'DxxD=Decrypt ' دالة التشفير Function ExxE(ByVal JudyDecrypt As String) As String Dim iIndex As Integer Dim iEncoder As Integer Dim iEncodedVal As Integer Randomize ExxE = "" For iIndex = 1 To Len(JudyDecrypt) Do iEncoder = Int(98 * Rnd + 89) iEncodedVal = Asc(Mid(JudyDecrypt, iIndex, 1)) Xor iEncoder Loop While iEncodedVal = 1000 Or iEncodedVal < 99 ExxE = ExxE & Chr(iEncodedVal) & Chr(iEncoder) Next iIndex End Function ' دالة فك التشفير Function DxxD(ByVal JudyEncrypt As String) As String Dim iIndex As Integer Dim iDecodedVal As Integer DxxD = "" For iIndex = 1 To Len(JudyEncrypt) Step 2 iDecodedVal = Asc(Mid(JudyEncrypt, iIndex, 1)) Xor Asc(Mid(JudyEncrypt, iIndex + 1, 1)) DxxD = DxxD & Chr(iDecodedVal) Next iIndex End Function

من مكتبتي .. أكواد لفتح الملفات الخارجية بدون رسائل تنبيه .. 🙂 (1) : Public Sub OpenFilePath(sFilePath As String) CreateObject("Shell.Application").Namespace(0).ParseName(sFilePath).InvokeVerb "Open" End Sub (2) : Public Sub OpenPath(strPath As String) Shell "explorer.exe" & " " & strPath, vbNormalFocus 'You can also Change it to : ' 'Shell "explorer.exe" & " " & strPath, vbHide 'Shell "explorer.exe" & " " & strPath, vbMaximizedFocus 'Shell "explorer.exe" & " " & strPath, vbMinimizedFocus 'Shell "explorer.exe" & " " & strPath, vbMinimizedNoFocus 'Shell "explorer.exe" & " " & strPath, vbNormalNoFocus End Sub (3) : Public Declare PtrSafe Function FileProtocolHandler Lib "url.dll" _ Alias "FileProtocolHandlerA" (ByVal hwnd As Long, ByVal hinst As Long, _ ByVal lpszCmdLine As String, ByVal nShowCmd As Long) As Long Public Sub OpenHyperlink(ByVal Url) FileProtocolHandler 0, 0, Url, 1 End Sub Sub test() OpenHyperlink ("D:\Testing") End Sub (4) : دالة ShellExecute لتشغيل البرامج أو الملفات الخارجية بدون رسائل مزعجة '=======================================(الدالة) Const SW_SHOW = 1 Const SW_SHOWMAXIMIZED = 3 Public Declare Ptrsafe Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _ (ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long '======================================= http://www.rdpslides.com/pptfaq/FAQ00479_ShellExecute_Example.htm '======================================= https://stackoverflow.com/questions/1374433/shellexecuteex-in-vba '======================================= 'SW_HIDE Hides the window. 'SW_MAXIMIZE Maximizes the window. 'SW_MINIMIZE Minimizes the window. 'SW_RESTORE Restores the window to normal (not maximized or minimized) size. 'SW_SHOW Activates the window and displays it at its current size. 'SW_SHOWDEFAULT Displays the window at a default size. 'SW_SHOWMAXIMIZED Displays the window maximized. 'SW_SHOWMINIMIZED Displays the window minimized. 'SW_SHOWMINNOACTIVE Displays the window minimized without giving it the focus. 'SW_SHOWNA Displays the window at its current size without giving it the focus. 'SW_SHOWNOACTIVATE Displays the window in its most recent size and position without giving it the focus. 'SW_NORMAL Displays the window at normal (not minimized or maximized) size. '============================================================(طرق الاستدعاء) Some particularly useful combinations include: Open a folder in a folder view: ShellExecute hWnd, "open", "C:\whatever", vbNullString, vbNullString, SW_SHOWNORMAL Explore a folder with Windows Explorer: ShellExecute hWnd, "explore", "C:\whatever", vbNullString, vbNullString, SW_SHOWNORMAL Launch the Find utility from a particular directory: ShellExecute hWnd, "find", "C:\whatever", vbNullString, vbNullString, SW_SHOWNORMAL Display a Web page in the system's default browser: ShellExecute hWnd, "open", "C:\whatever\test.html", vbNullString, vbNullString, SW_SHOWNORMAL (5) :دالة ShellWait لفتح الملفات الخارجية والإنتظار حتى تنتهي المهمة '-----------------------------------------------------------------------------------www.officena.net-----' ' __ __ _ ' ' / _|/ _| | | ' ' __ ____ ____ _____ | |_| |_(_) ___ ___ _ __ __ _ _ __ ___| |_ ' ' \ \ /\ / /\ \ /\ / /\ \ /\ / / _ \| _| _| |/ __/ _ \ '_ \ / _\`| | '_ \ / _ \ __| ' ' \ V V / \ V V / \ V V / (_) | | | | | | (_| __/ | | | (_| |_| | | | __/ |_ ' ' \_/\_/ \_/\_/ \_/\_(_)___/|_| |_| |_|\___\___|_| |_|\__,_(_)_| |_|\___|\__| ' ' Developed By Mohammed Essam ' '------www.officena.net----------------------------------------------------------------------------------' Option Compare Database Option Explicit '***************** Code Start ****************** 'This code was originally written by Terry Kreft. 'It is not to be altered or distributed, 'except as part of an application. 'You are free to use it in any application, 'provided the copyright notice is left unchanged. ' 'Code Courtesy of 'Terry Kreft Private Const STARTF_USESHOWWINDOW& = &H1 Private Const NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& Private Type STARTUPINFO cb As Long lpReserved As String lpDesktop As String lpTitle As String dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Long hStdInput As Long hStdOutput As Long hStdError As Long End Type Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessID As Long dwThreadID As Long End Type #If VBA7 And Win64 Then Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal _ hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _ lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _ lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _ ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _ ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _ lpStartupInfo As STARTUPINFO, lpProcessInformation As _ PROCESS_INFORMATION) As Long Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal _ hObject As Long) As Long #Else Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _ hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function CreateProcessA Lib "kernel32" (ByVal _ lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _ lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _ ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _ ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _ lpStartupInfo As STARTUPINFO, lpProcessInformation As _ PROCESS_INFORMATION) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal _ hObject As Long) As Long #End If Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long) Dim proc As PROCESS_INFORMATION Dim Start As STARTUPINFO Dim Ret As Long ' Initialize the STARTUPINFO structure: With Start .cb = Len(Start) If Not IsMissing(WindowStyle) Then .dwFlags = STARTF_USESHOWWINDOW .wShowWindow = WindowStyle End If End With ' Start the shelled application: Ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, _ NORMAL_PRIORITY_CLASS, 0&, 0&, Start, proc) ' Wait for the shelled application to finish: Ret& = WaitForSingleObject(proc.hProcess, INFINITE) Ret& = CloseHandle(proc.hProcess) End Sub '***************** Code End **************** وتناديها : ShellWait("C:\MyApp.exe", vbNormalFocus) أختر اللي يعجبك منها 😁

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

مبارك عليك الترقية أخي @Ahmed_J .. 🙂🌹 إضافة ثمينة للمنتدى وجوهرة تضاف لهذا العقد الجميل 🙂

جرب هذا : 🙂

شكرا جزيلا أخي @Hamtoooo .. هدية مقبولة 🙂 تصميم رائع وراقي ماشاء الله تبارك الرحمن 😎

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

للفائدة هذي دالة Function وضيفتها تعيين الخواص لقاعدة البيانات .. وفي حال لو لقيها ما موجودة ينشأها 🙂 Public Enum propType PropTypeString = 1 PropTypeInteger = 2 PropTypeDouble = 3 PropTypeBoolean = 4 PropTypeDate = 5 End Enum Function CreateProperty(propName As String, propType As propType, propValue As Variant) ' Chat GPT On Error Resume Next Dim app As dao.Database Set app = CurrentDb app.CreateProperty propName, propType, propValue, True If Err.Number <> 0 Then ' Property already exists, set the value app.Properties(propName) = propValue End If On Error GoTo 0 End Function وتناديها بهذي الطريقة : Call CreateProperty("MyProperty", PropTypeString, "Hello World!")

وهنا أيضا قمت بعمل كود لإضافة السجلات وترقيمها 🙂 وهذا هو الكود : Sub Add_2000_Record() Dim x As Long For x = 1 To 2000 CurrentDb.Execute "INSERT INTO Ta1 ( IDD ) VALUES (" & x & ");" Next End Sub إضافة2000سجل.rar

أخي مصطفى .. الأكسس يقدم لك طرق سهلة لاستيراد البيانات من مصادر خارجية كالأكسل أو قاعدة أكسس أخرى أو قواعد البيانات الأخرى .. وسائل غير النسخ واللصق 🙂 وكان سؤال المهندس جعفر عن مكان تخزين بيانات هؤلاء ال 2000 موظف لينطلق بك وبنا إلى الوسائل السهلة لاستيراد هذه البيانات لبرنامجك .. 🙂

هناك حيل عديدة يمكن للمستخدم أن يفعلها للتحايل على هذه الخطوة .. منها الضغط على Alt+F4 وأيضا Alt+Ctrl+Delete ومنها Ctrl+W 🙂 وعلى العموم .. ممكن تستخدم نفس كود التحقق من كلمة المرور والباسوورد ولكن بدل فتح النموذج تكتب : DoCmd.Quit

الكلام غير مفهوم أخي طاهر .. !! 🙃

على فكرة قمت بتجربة الكود وعمل معي بنجاح 🙂 أولا : أحضرت رابط لنموذج ملف txt من هذا الموقع والذي يوفر لك نماذج Samples جاهزة للتحميل بروابط مباشرة لكل أنواع الملفات : https://filesamples.com وهذا كان رابط الملف النصي : https://filesamples.com/samples/document/txt/sample2.txt وعملت نموذج بسيط للتجربة وهذه هي النتيجة : 🙂 Read Online Txt File.accdb

ومادام ال 00 عاملالك مشكلة خليها 11 ولا 22 ولا 33 مش هتفرق معاك 😅

ما دامك مصر أنه الموضوع ما يحتاج مثال .. 🙂 استخدم هذا الكود على زر أمر بحيث تغير رابط الملف النصي وتغير اسم مربع النص اللي بيلصق النص فيه : Private Sub btnGetText_Click() ' Declare variables to hold the text from the online file and the textbox Dim strText As String Dim txtTarget As TextBox ' Set the URL of the online text file Dim strURL As String strURL = "http://www.website.com/text.txt" ' Use the XMLHTTP object to retrieve the text from the online file Dim objXMLHTTP As Object Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP") objXMLHTTP.Open "GET", strURL, False objXMLHTTP.Send ' Check if the request was successful If objXMLHTTP.Status = 200 Then ' Get the text from the response strText = objXMLHTTP.responseText ' Get a reference to the textbox on the form Set txtTarget = Me.txtTextBox ' Put the text from the online file into the textbox txtTarget.Value = strText Else ' Show an error message if the request was not successful MsgBox "There was an error retrieving the text from the online file." & vbCrLf & _ "HTTP Status: " & objXMLHTTP.Status, vbExclamation End If ' Clean up Set objXMLHTTP = Nothing Set txtTarget = Nothing End Sub