Moosak

وعليكم السلام ورحمة الله وبركاته 🙂 من مكتبتي .. هذه دالتان الأولى لتشفير البيانات والثانية لفك التشفير .. أخذتهما من أحد البرامج الخاصة بأستاذنا العزيز @ابو جودي أزال الله أتراحه وأدام الله أفراحه .. 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

شكرا لك يا @محب العقيدة 🙂 يحتاجلي مدة لحد ما أبلع الموضوع بشكل مضبوط 😅 طيب سؤال : بالنسبة للبرامج المعروفة مثل الفوتوشوب وبرامج الأوفيس وغيرها .. أيش من قواعد البيانات تستخدم ؟ وفي الغالب أنه أثناء تنصيبها مايجي طاري الـ sqlserver لتنصيبه معها .. ولا أنها تستخدم قواعد بيانات من نوع آخر ؟

أخي مالك .. أعطنا مثال حي لما تريده بالضبط ... ( رابط حقيقي + النص الذي تريد نقله بالضبط )

أهلا بك أخي مالك في المنتدى .. 🙂 رابط الملف لايعمل .. ! ولكن ما يدور في ذهني الآن هو تحميل الملف بشكل مؤقت في الجهاز ، ثم فتح الملف ونسخ ما فيه إلى مربع النص في النموذج .. وبعدها حذف الملف المؤقت .. كل ذلك عن طريق الأكواد .. شريطة أن يكون الرابط للملف مباشر .. وليس من مواقع التحميل التي تلف بك وتدور لحد ما تعطيك رابط التحميل 🙂 وربما هناك طريقة أسهل لا أعلمها 🙂

وعليكم السلام ورحمة الله وبركاته أخي @محب العقيدة 🙂 موضوع جميل جدا ويجيب على السؤال الماضي عن كيفية حفظ الملفات في قاعدة SQL .. شكرا لك على وقتك وجهدك الرااائع .. 🙂🌹 السؤال القادم هو : كيف تتعامل مع ملفات قاعدة الـ SQL وتنصبها في جهاز العميل كقاعدة محلية ؟ وكيفية ضبط جهاز العميل ( أهم الإعدادات الضرورية الأساسية ) ؟ وكيف يمكنني حملها من جهاز إلى آخر لي كمبرمج شخصيا عندما أكون أعمل على جهازين غير مرتبطين بشبكة ؟ مثلا هل يمكن العمل عليها وهي في فلاشة USB ؟ سؤال آخر : كيف نعمل نسخ احتياطي تلقائي لقاعدة البيانات عن طريق الكود مثلا ؟ وكيف نسترجع القاعدة من أحد النسخ الاحتياطية فيما لو تلفت القاعدة الأصلية ؟ هذه الأسئلة تأتي من باب معرفتي المتواضعة بأن قاعدة الأكسس جميعها في ملف واحد يسهل نقله .. بينما الـ SQL لها عدة ملفات مترابطة ببعضها .. ( فقط ما متخيل كيف يتم الموضوع 🙃 )

أهلا بك مجددا يا عزرائيل 🙂 هل من المفترض أن يقوم البرنامج بتحويل ملفات ال PDF إلى صور ؟ لم يعمل معي ..

كيف ؟ 🙂

شكرا لك على التوضيح أستاذنا أبو أحمد 🙂 وأعتقد أننا نحتاج منك لتحليل للنتائج الأخيرة للمفاضلة بين الطرق التي ذكرتها 🙂 --------------------------- وفي ذات الموضوع .. وجدت في أحد المواقع دالة اسمها IsBlank وظيفتها فحص وجود البيانات من عدمه لجميع الأنواع، وأنا أستخدمها وتعمل معي بكفاءة عالية 🙂 : '----------------------------------------------------------------------------- ' True if the argument is Nothing, Null, Empty, Missing or an empty string . '----------------------------------------------------------------------------- Public Function IsBlank(arg As Variant) As Boolean Select Case VarType(arg) Case vbEmpty IsBlank = True Case vbNull IsBlank = True Case vbString IsBlank = (LenB(arg) = 0) Case vbObject IsBlank = (arg Is Nothing) Case Else IsBlank = IsMissing(arg) End Select End Function وتناديها بهذا الشكل : IsBlank(Me.UserNameTxt) ----------------------------------------مثال آخر If IsBlank(Me.CustomerReferenceTxt) Then MsgBox "Customer Reference cannot be left blank." End If المصدر

هنا جهزتلك نموذج البيانات الشهرية عشان يشتغل وحده 🙂 بيانات الأعضاء - 2.accdb

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