البحث في الموقع

بسم الله الرحمن الرحيم.. السلام عليكم ورحمة الله وبركاته.. بعد طول غياب عن الساحة بسبب ضروف الحياة والعمل.. اقدم لكم اداة صغيرة من برمجتي بلغة Visual Studio .NET تقوم بالتقاط الصور كاميرا الويب او اي كاميرا متصلة بالكومبيوتر ومن ثم خزنها في الجهاز الاداة قمت بربطها مع الاكسس، بحيث تقوم بتمرير براميتر من الاكسس الى الاداة وهذا البراميتر متمثل بـ مسار حفظ الصورة + واسم الصورة + صيغتها مثال: Dim SavedPath As String SavedPath = """" & CurrentProject.Path & "\Capture.png" & """" الاداة تستخدم مكتبات AForge للتحكم بالكاميرات. صورة الاداة: بمجرد ان تضغط زر Open Camera من الاكسس ستعمل الاداة مباشرة قم بترتيب الكاميرا الخاصة بك لاخذ لقطة مناسبة واضغط على الزر Snapshot ثم اضغط على الز save لحفظ الصورة. الاداة اخذت مني وقت 8 ساعات في البرمجة لذلك لا تنسوني ووالدي من صالح دعائكم. تم بحمد الله. SEMO_webCam.rar كلمات مفتاحية: التقاط صورة من الكاميرا، حفظ الصورة من الكاميرا، جلب الصورة من كاميرا الويب، جلب الصورة من الكاميرا وحفظها في قاعدة البيانات، حفظ الصور بقاعدة البيانات، خزن الصورة من الكاميرا كاميرا ويب قاعدة بيانات اكسس، اكسس كاميرا الويب، اكسس كاميرا، جلب الصورة من الكاميرا

السلام عليكم, في سنة 2017 قمت بكتابة كلاس بسيط لحماية برنامجي ولضمان برنامجي لا يعمل في غير كومبيوترات في حاله بيعه. مميزات الكلاس: 1- قفل قاعدة البيانات على ( رقم الهارد , البروسيسور , المذربورد , الماك أدريس ) 2- (استحاله) فك النماذج والتقارير في حال عدم تجاوزك لنموذج ( تسجيل الدخول ) ببساطة ستقول يمكنني العثور على باسورد القاعدة داخل الجدول ( الطريقة المعتادة لدينا جميعا في انشاء نموذج تسجيل دخول ). قبل كل شي ليكن لدينا مثلا جدول اسمة ( tbl_Login ) و نموذج اسمه ( frm_Login ) الجدول لتخزين اسم المستخدم وكلمة المرور والنموذج لعمل تسجيل الدخول عند ذهابنا للجدول ( tbl_Login ) ، سوف نحصل على باسورد مشفر من الجدول لو كان الباسورد مثلا ( 313 ) فإنك ستحصل على ( 701D6068 ) 2- عندما نقوم بتسجيل الدخول في النموذج سيقوم البرنامج بأخذ كلمة السر المدخلة ويقوم بتشفيرها ثم يقوم بمطابقتها مع الباسورد الموجود في الجدول اذا كان الباسورد المُدخل يطابق الجدول سيكتب قيمة معينة runtime ويقوم بازالة جميع القيود من النماذج والتقارير. اولا: كلاس الحماية Option Compare Database '----------------------------------------------------- ' Protection Module Coded By Hassanein Hirz Aldeen (SEMO.Pa3x) ' Date 26/11/2017 ' All rights reserved. copyright © 2017 '----------------------------------------------------- Public SEMO As String Function SEMO_GET() SEMO = SEMO SEMO_GET = SEMO End Function Function PR() As Boolean PR = False 'False=Disabled , True=Enabled End Function Function HWND_ID() HWND_ID = "3C3F4825" 'Your HWID End Function Function HWND_MSG() HWND_MSG = "...ليست لديك صلاحيات كافية لإستخدام هذا الاجراء" End Function Function KEY_ENDE() KEY_ENDE = "PA$X" End Function Function HWND_GET() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_GET = disk.volumeserialnumber Exit For End If Next End Function Function HWND_PROTECTION() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_PROTECTION = disk.volumeserialnumber Exit For End If Next If HWND_ID = HWND_PROTECTION Then HWND_PROTECTION = "True" Else HWND_PROTECTION = "False" End If End Function 'Code contained within module named mdlforencryptionanddecryption Public Function XORDecryption(CodeKey As String, DataIn As String) As String Dim arkdata1 As Long Dim strDataOut As String Dim intXOrValue1 As Integer Dim intXOrValue2 As Integer For arkdata1 = 1 To (Len(DataIn) / 2) 'The first value to be XOr-ed comes from the data to be encrypted intXOrValue1 = Val("&H" & (Mid(DataIn, (2 * arkdata1) - 1, 2))) 'The second value comes from the code key intXOrValue2 = Asc(Mid(CodeKey, ((arkdata1 Mod Len(CodeKey)) + 1), 1)) strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2) Next arkdata1 XORDecryption = strDataOut End Function Public Function XOREncryption(CodeKey As String, DataIn As String) As String Dim arkdata1 As Long Dim strDataOut As String Dim temp As Integer Dim tempstring As String Dim intXOrValue1 As Integer Dim intXOrValue2 As Integer For arkdata1 = 1 To Len(DataIn) 'The first value to be XOr-ed comes from the data to be encrypted intXOrValue1 = Asc(Mid$(DataIn, arkdata1, 1)) 'The second value comes from the code key intXOrValue2 = Asc(Mid$(CodeKey, ((arkdata1 Mod Len(CodeKey)) + 1), 1)) temp = (intXOrValue1 Xor intXOrValue2) tempstring = Hex(temp) If Len(tempstring) = 1 Then tempstring = "0" & tempstring strDataOut = strDataOut + tempstring Next arkdata1 XOREncryption = strDataOut End Function الاستخدام لكل النماذج والتقارير اكتب في حدث Form_Load Option Compare Database Private Sub Form_Load() On Error Resume Next If HWND_PROTECTION = "False" Then MsgBox HWND_MSG, vbCritical, "عملية خاطئة" For i = 0 To Controls.Count - 1 Dim X As Control Set X = Me.Controls.Item(i) X.Visible = False Next DoCmd.Close DoCmd.CloseDatabase DoCmd.Quit End If If Protection.SEMO_GET = "SEMO" = False Then MsgBox HWND_MSG, vbCritical, "عملية خاطئة" For i = 0 To Controls.Count - 1 Dim XS As Control Set XS = Me.Controls.Item(i) XS.Visible = False Next DoCmd.Close DoCmd.CloseDatabase DoCmd.Quit End If End Sub الان عندما تريد اعطاء القاعدة لشخص ما قم باعطاءه اولا ملف الـ VBS هذا '----------------------------------------------------- ' ReCoded By Hassanein Hirz Aldeen (SEMO.Pa3x) ' Date 26/11/2017 ' All rights reserved. copyright © 2017 '----------------------------------------------------- ' Get clipboard text Set objHTML = CreateObject("htmlfile") Set Ws = CreateObject("WScript.Shell") Clipboardtext = objHTML.ParentWindow.ClipboardData.GetData("text") sText = HWND_GET 'Set Clipboard Ws.Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(sText, "\", "\\"), "'", "\'") & "');close();""", 0, True MsgBox "Copied!" Function HWND_GET() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_GET = disk.volumeserialnumber Exit For End If Next End Function وظيفة هذا الملف يقوم باستخراج ( رقم الهارد , البروسيسور , المذربورد , الماك أدريس ) ثم ينسخه بعدما يشغله سيقوم العميل باعطاءك هذا الرقم لكي تقوم انت بدورك بوضعه داخل الكلاس في المنطقة Function HWND_ID() HWND_ID = "Your HWID" End Function استبدل كلمة ( Your HWID ) بالرقم الذي سيعطيه لك العميل. ثم بعد ذلك قم بحفظ القاعدة بصيغة ( ACCDE ) واتحدا اي شخص يفتحها مرة اخرى: لكي تفتح النماذج والتقارير عليك بتخطي نموذج تسجيل الدخول ارفقت لكم قاعدة محمية وقاعدة بدون حماية مع ملف الـ VBS الذي يستخرج ارقام قطع الجهاز ويقوم بنسخها،، اتمنى لكم الفائدة جميعاً اهداء الموضوع الى مُعلمي الرائع @jjafferr حسنين Login_SEMO_Pa3x.rar

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته.. اقدم لكم اداة من برمجتي المتواضعة لتحويل اكواد الـ SQL الى VBA قبل كل شي، الاداة حصراً للمبرمجين الذين يستخدمون الكود في الادراج والتعديل والحذف وليس للأشخاص الذين يستخدمون الواجهة الرسومية للأكسس الخالية من الكود ماهي فائدة الأداة ولماذا استخدمها؟ حسناً، لو كان لدينا جدول اسمة tbl_movementes يقوم بتسجيل جميع الحركات التي تحدث ( اضافة , تعديل , حذف ) وهذا الجدول احتاجه في كثير من النماذج، فهل من المعقول ان اقوم بكتابة عبارة INSERT INTO في كل نموذج ؟ اكيد لا، سأقوم بكتابة Sub واقوم بإستدعاءه كل مرة اريد ان اضيف بها بيانات الى الجدول واختصاراً للوقت الطويل والأخطاء التي ربما ستحدث اثناء عملية التحويل، قمت بكتابة اداة تقوم بهذا الغرض الاداة وضيفتها فقط ( Insert , Update ) صورة الاداة: لنطبق على عملية اضافة بيانات جديد: 1- قم بفتح 2- ثم قم بأختيار الجدول الذي تريده، وقم بإدراج جميع الحقول، كما في الصورة 3- من النافذة العليا اختر النافذة تصميم وقم بتعديل نوع الاستعلام الى استعلام إلحاق وثم بإختيار نفس الجدول لكي يقوم بألحاق البيانات به. الآن لنرى النتيجة 3- الان قم بعرض اكواد الـ SQL 4- قم بنسخ جميع الاكواد كما في الصورة الاتية 5- الان قم بفتح الاداة، واختر النوع Insert، ثم الصق اكواد الـ SQL في مربع النص SQL 6- قبل عملية التحويل قم بإلغاء الأعمدة التي لا ترغب بها من القائمة على اليمين ( Column Remove ) مثلا سأقوم بألغاء العمود IsDeleted وذلك بالضغط على اسم العمود رسالة تخبرك بتأكيد عملية حذف العمود 7- اضغط على الزر Convert 8- تم تحويل الكود ونسخه، الان قم بلصقه في الأكسس واستخدمه الاستخدام النتيجة، تم ادراج البيانات بالجدول لنطبق على عملية تعديل البيانات: نفس الخطوات القديمة فقط من الاداة اختر نوع الاستعلام Update من المعروف ان عملية تعديل البيانات تتطلب معيار للتعديل WHERE COLUMN NAME = Number لذلك عندما نقوم بإنشاء الاستعلام نقوم بوضع عمود المعيار اخر عمود في الاستعلام هكذا من لديه ملاحظات أو اضافات تعطى للبرمج حصراً أحرم تعديل البرنامج بأحد ادوات الهندسة العكسية او نسبه لأي شخص تمت البرمجة حصرياً لمنتدى أوفسينا، اهداء الى معلمي العزيز @jjafferr تحياتي للجميع. SQL-VBA.rar

السلام عليكم ورحمة الله وبركاته.. كنت قد طرحت سابقًا موضوع يتكلم عن ارسال رسائل الى الواتس اب لعدد X من المستخدمين من خلال الاكسس وهنا X معناها عدد معين كأن يكون 10 مستخدمين او اكثر او اقل.. الموضوع القديم كان فيه مشكلة وهو ان رسائل الواتس اب الطويلة لا يمكن ارسال او تُرسل بشكل مقطوع! الحمدلله في هذا الاصدار تم التغلب نهائيًا على هذه المشكلة واصبح البرنامج يرسل عدد كلمات بالعدد الذي يسمح به الواتس اب الجديد في هذا الاصدار: امكانية ارسال المرفقات ( الصور فقط ) 1- يمكنك ارسال رسائل فقط 2- يمكنك ارسال صور فقط 3- يمكنك ارسال رسالة مع صورة صورة مشروع الاكسس: قم بتحديد الاشخاص الذين تريد ارسال الرسالة لهم مع وضع نص الرسالة مع امكانية تحديد الكل يمكنك شروط البرنامج بحسب ماتراه مناسباً. النتيجة: ملاحظة يجب ان يكون برنامج الواتس اب موجود في جهاز الكومبيوتر واهم ملاحظة هي يجب كتاب رقم الواتس اب الذي تريد ان ترسل له الرسالة كما يظهر في البرنامج، مثال: لتحميل الواتس اب من الرابط الاتي: https://www.whatsapp.com/download بالمناسبة: الحمدلله انتهيت من برنامج تحويل الصور الى نصوص مهما كانت اللغة ( OCR ) وخصوصا اللغة العربية وحتى الصور التي تكون مكتوبة بخط اليد يتم تحويلها الى نصوص يسهل التعديل عليها في برنامج الوورد البرنامج يعمل بطريقتين: 1- يمكنك تحويل الصور بشكل مباشر 2- يمكنك استخدام الاكسس في ارسال CommandLine يتضمن مسار الصورة ومسار ملف التكست للنص الذي سوف يحفظ وسيقوم البرنامج بعمله لا تنسوني ووالدي من صالح دعائكم. تم بحمد الله. SendWhatsAppMessages.rar

السلام عليكم ورحمة الله وبركاته.. من المعروف ان الواتس اب يسمح لك بارسال 5 رسائل فقط في كل مرة يعني لو كان لدينا 15 شخص نريد ان نرسل له رسالة علينا ان نقوم باعادة توجيه الرسالة 3 مرات كل مرة 5 اشخاص.. قمت بعمل اداة صغيرة في الـ NET. لتقوم بهذه المهمة. صورة مشروع الاكسس: قم بتحديد الاشخاص الذين تريد ارسال الرسالة لهم مع وضع نص الرسالة مع امكانية تحديد الكل يمكنك شروط البرنامج بحسب ماتراه مناسباً. النتيجة: ملاحظة يجب ان يكون برنامج الواتس اب موجود في جهاز الكومبيوتر واهم ملاحظة هي يجب كتاب رقم الواتس اب الذي تريد ان ترسل له الرسالة كما يظهر في البرنامج، مثال: لتحميل الواتس اب من الرابط الاتي: https://www.whatsapp.com/download لا تنسوني ووالدي من صالح دعائكم. تم بحمد الله. Whatsapp-Message-Sender.rar

السلام عليكم ورحمة الله وبركاته.. اقدم لكم اداة صغيرة من برمجتي وضيفتها تغيير اسم الدولة/المنطقة التي تعتمد عليها الكثير من البرامج خصوصاً العربية التي تعتمد الـ Unicode الأداة مكتوب بلغة Visual Studio .NET مبدأ عملها يحتاج ان تقوم بتمرير براميتر لها يحتوي على كود الدولة. عموما كتبت لكم مثال في الاكسس سورس الأداة: Imports System.Runtime.InteropServices Imports System.Threading Imports Microsoft.Win32 Imports System.Globalization Module Main 'C0ded bY: SEMO.Pa3x (: 'Date: 27-5-2021 : 03:26 PM Const subkey As String = "SYSTEM\CurrentControlSet\Control\Nls\Language\" Dim CodeArray As String() = {"af-ZA", "ar-AE", "ar-BH", "ar-DZ", "ar-EG", "ar-IQ", "ar-JO", "ar-KW", "ar-LB", "ar-LY", "ar-MA", "ar-OM", "ar-QA", "ar-SA", "ar-SY", "ar-TN", "ar-YE", "az-AZ", "az-AZ", "be-BY", "bg-BG", "bs-BA", "ca-ES", "cs-CZ", "cy-GB", "da-DK", "de-AT", "de-CH", "de-DE", "de-LI", "de-LU", "dv-MV", "el-GR", "en-AU", "en-BZ", "en-CA", "en-CB", "en-GB", "en-IE", "en-JM", "en-NZ", "en-PH", "en-TT", "en-US", "en-ZA", "en-ZW", "es-AR", "es-BO", "es-CL", "es-CO", "es-CR", "es-DO", "es-EC", "es-ES", "es-ES", "es-GT", "es-HN", "es-MX", "es-NI", "es-PA", "es-PE", "es-PR", "es-PY", "es-SV", "es-UY", "es-VE", "et-EE", "eu-ES", "fa-IR", "fi-FI", "fo-FO", "fr-BE", "fr-CA", "fr-CH", "fr-FR", "fr-LU", "fr-MC", "gl-ES", "gu-IN", "he-IL", "hi-IN", "hr-BA", "hr-HR", "hu-HU", "hy-AM", "id-ID", "is-IS", "it-CH", "it-IT", "ja-JP", "ka-GE", "kk-KZ", "kn-IN", "ko-KR", "kok-IN", "ky-KG", "lt-LT", "lv-LV", "mi-NZ", "mk-MK", "mn-MN", "mr-IN", "ms-BN", "ms-MY", "mt-MT", "nb-NO", "nl-BE", "nl-NL", "nn-NO", "ns-ZA", "pa-IN", "pl-PL", "ps-AR", "pt-BR", "pt-PT", "qu-BO", "qu-EC", "qu-PE", "ro-RO", "ru-RU", "sa-IN", "se-FI", "se-FI", "se-FI", "se-NO", "se-NO", "se-NO", "se-SE", "se-SE", "se-SE", "sk-SK", "sl-SI", "sq-AL", "sr-BA", "sr-BA", "sr-SP", "sr-SP", "sv-FI", "sv-SE", "sw-KE", "syr-SY", "ta-IN", "te-IN", "th-TH", "tl-PH", "tn-ZA", "tr-TR", "tt-RU", "uk-UA", "ur-PK", "uz-UZ", "uz-UZ", "vi-VN", "xh-ZA", "zh-CN", "zh-HK", "zh-MO", "zh-SG", "zh-TW", "zu-ZA"} Sub main() For Each arg As String In My.Application.CommandLineArgs 'check if arg exist in array ! Dim index As Integer = Array.IndexOf(CodeArray, arg) If index > 0 Then 'do change (: SetSystemNonUnicodeLanguage(CultureInfo.GetCultureInfo(arg)) End If Next End Sub Private Sub SetSystemNonUnicodeLanguage(ByVal cinfo As CultureInfo) Dim regkey = Registry.LocalMachine.OpenSubKey(subkey, True) regkey.SetValue("Default", cinfo.LCID.ToString("x4")) ' Reboot computer after timeout of 5 Shell("Shutdown -r -t 5") ' Switches: ' -l Log off profile ' -s Shut down computer ' -r Restart computer ' -f Force applications to close ' -t Set a timeout for shutdownCodeArray ' -m \\computer name (Shutdown remote computer) ' -i Show the Shutdown GUI End Sub End Module البرنامج: Option Compare Database Private Declare 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 Const SW_SHOWNORMAL = 1 Private Sub cmd_change_Click() Dim SetLocaleInfo_File As String Dim Parameters As String SetLocaleInfo_File = CurrentProject.Path + "\SetLocaleInfo.exe" Parameters = comb_countries ShellExecute 0, "runas", SetLocaleInfo_File, Parameters, vbNullString, SW_SHOWNORMAL End Sub ارفقت لكم جدول لإسماء الدولة ورموزها: Code Country af-ZA Afrikaans (South Africa) ar-AE Arabic (U.A.E.) ar-BH Arabic (Bahrain) ar-DZ Arabic (Algeria) ar-EG Arabic (Egypt) ar-IQ Arabic (Iraq) ar-JO Arabic (Jordan) ar-KW Arabic (Kuwait) ar-LB Arabic (Lebanon) ar-LY Arabic (Libya) ar-MA Arabic (Morocco) ar-OM Arabic (Oman) ar-QA Arabic (Qatar) ar-SA Arabic (Saudi Arabia) ar-SY Arabic (Syria) ar-TN Arabic (Tunisia) ar-YE Arabic (Yemen) az-AZ Azeri (Latin) (Azerbaijan) az-AZ Azeri (Cyrillic) (Azerbaijan) be-BY Belarusian (Belarus) bg-BG Bulgarian (Bulgaria) bs-BA Bosnian (Bosnia and Herzegovina) ca-ES Catalan (Spain) cs-CZ Czech (Czech Republic) cy-GB Welsh (United Kingdom) da-DK Danish (Denmark) de-AT German (Austria) de-CH German (Switzerland) de-DE German (Germany) de-LI German (Liechtenstein) de-LU German (Luxembourg) dv-MV Divehi (Maldives) el-GR Greek (Greece) en-AU English (Australia) en-BZ English (Belize) en-CA English (Canada) en-CB English (Caribbean) en-GB English (United Kingdom) en-IE English (Ireland) en-JM English (Jamaica) en-NZ English (New Zealand) en-PH English (Republic of the Philippines) en-TT English (Trinidad and Tobago) en-US English (United States) en-ZA English (South Africa) en-ZW English (Zimbabwe) es-AR Spanish (Argentina) es-BO Spanish (Bolivia) es-CL Spanish (Chile) es-CO Spanish (Colombia) es-CR Spanish (Costa Rica) es-DO Spanish (Dominican Republic) es-EC Spanish (Ecuador) es-ES Spanish (Castilian) es-ES Spanish (Spain) es-GT Spanish (Guatemala) es-HN Spanish (Honduras) es-MX Spanish (Mexico) es-NI Spanish (Nicaragua) es-PA Spanish (Panama) es-PE Spanish (Peru) es-PR Spanish (Puerto Rico) es-PY Spanish (Paraguay) es-SV Spanish (El Salvador) es-UY Spanish (Uruguay) es-VE Spanish (Venezuela) et-EE Estonian (Estonia) eu-ES Basque (Spain) fa-IR Farsi (Iran) fi-FI Finnish (Finland) fo-FO Faroese (Faroe Islands) fr-BE French (Belgium) fr-CA French (Canada) fr-CH French (Switzerland) fr-FR French (France) fr-LU French (Luxembourg) fr-MC French (Principality of Monaco) gl-ES Galician (Spain) gu-IN Gujarati (India) he-IL Hebrew (Israel) hi-IN Hindi (India) hr-BA Croatian (Bosnia and Herzegovina) hr-HR Croatian (Croatia) hu-HU Hungarian (Hungary) hy-AM Armenian (Armenia) id-ID Indonesian (Indonesia) is-IS Icelandic (Iceland) it-CH Italian (Switzerland) it-IT Italian (Italy) ja-JP Japanese (Japan) ka-GE Georgian (Georgia) kk-KZ Kazakh (Kazakhstan) kn-IN Kannada (India) ko-KR Korean (Korea) kok-IN Konkani (India) ky-KG Kyrgyz (Kyrgyzstan) lt-LT Lithuanian (Lithuania) lv-LV Latvian (Latvia) mi-NZ Maori (New Zealand) mk-MK FYRO Macedonian (Former Yugoslav Republic of Macedonia) mn-MN Mongolian (Mongolia) mr-IN Marathi (India) ms-BN Malay (Brunei Darussalam) ms-MY Malay (Malaysia) mt-MT Maltese (Malta) nb-NO Norwegian (Bokm?l) (Norway) nl-BE Dutch (Belgium) nl-NL Dutch (Netherlands) nn-NO Norwegian (Nynorsk) (Norway) ns-ZA Northern Sotho (South Africa) pa-IN Punjabi (India) pl-PL Polish (Poland) ps-AR Pashto (Afghanistan) pt-BR Portuguese (Brazil) pt-PT Portuguese (Portugal) qu-BO Quechua (Bolivia) qu-EC Quechua (Ecuador) qu-PE Quechua (Peru) ro-RO Romanian (Romania) ru-RU Russian (Russia) sa-IN Sanskrit (India) se-FI Sami (Northern) (Finland) se-FI Sami (Skolt) (Finland) se-FI Sami (Inari) (Finland) se-NO Sami (Northern) (Norway) se-NO Sami (Lule) (Norway) se-NO Sami (Southern) (Norway) se-SE Sami (Northern) (Sweden) se-SE Sami (Lule) (Sweden) se-SE Sami (Southern) (Sweden) sk-SK Slovak (Slovakia) sl-SI Slovenian (Slovenia) sq-AL Albanian (Albania) sr-BA Serbian (Latin) (Bosnia and Herzegovina) sr-BA Serbian (Cyrillic) (Bosnia and Herzegovina) sr-SP Serbian (Latin) (Serbia and Montenegro) sr-SP Serbian (Cyrillic) (Serbia and Montenegro) sv-FI Swedish (Finland) sv-SE Swedish (Sweden) sw-KE Swahili (Kenya) syr-SY Syriac (Syria) ta-IN Tamil (India) te-IN Telugu (India) th-TH Thai (Thailand) tl-PH Tagalog (Philippines) tn-ZA Tswana (South Africa) tr-TR Turkish (Turkey) tt-RU Tatar (Russia) uk-UA Ukrainian (Ukraine) ur-PK Urdu (Islamic Republic of Pakistan) uz-UZ Uzbek (Latin) (Uzbekistan) uz-UZ Uzbek (Cyrillic) (Uzbekistan) vi-VN Vietnamese (Viet Nam) xh-ZA Xhosa (South Africa) zh-CN Chinese (S) zh-HK Chinese (Hong Kong) zh-MO Chinese (Macau) zh-SG Chinese (Singapore) zh-TW Chinese (T) zu-ZA Zulu (South Africa) مدة العمل ( ساعة ونصف ) SetLocaleInfo.rar

السلام عليكم ورحمة الله وبركاته... عود على بدء في موضوعي هذا: اقدم لكم النسخة الثانية من اداة رفع الملفات ونسخ الباك اب الى Google Drive لكن هذه المرة ستقوم الاداة بضغط الملف وتشفيرة بباسورد بأستخدام winRAR ومن ثم رفعه الى Google Drive لمنع اي شخص من الاطلاع على محتويات الملف المضغوط لان الضغط هنا سيكون Encrypt File Names بعبارة اخرى سيكون الملف المضغوط هكذا شكله: لن تستطيع ان تعرف ما يحويه الملف المضغوط من ملفات الا اذا قمت بوضع الباسورد. اضفت براميتر جديد على الاداة وهو باسورد الضغط، ستجدون كل شيء في ملف الاكسس، وباقي الامور شرحناها في الدرس السابق لا تنسوني ووالدي من صالح دعائكم. تم بحمد الله. GoogleDriveUploader_fixed.rar

السلام عليكم.. اداة صغيرة مكتوبة كـ مفتاح registry عند تشغيلها ستقوم باضافة خيار جديد في الزر الايمن للماوس وضيفته جلب مسار الملفات والمجلدات لسرعه الوصول لها في البرامج او غيرها.. الاداة ليست من كتابتي انما فقط قمت بالتعديل عليها.. سورس الاداة: Windows Registry Editor Version 5.00 ; ########################################## ; Application : Get files/directories path by right click windows ; Coded by : Dr.Hassanien (SEMO.Pa3x) ; Date : 28-2-2022 ; ########################################## [HKEY_CLASSES_ROOT\Allfilesystemobjects\shell\windows.copyaspath] "CanonicalName"="{707C7BC6-685A-4A4D-A275-3966A5A3EFAA}" "CommandStateHandler"="{3B1599F9-E00A-4BBF-AD3E-B3F99FA87779}" "CommandStateSync"="" "Description"="@shell32.dll,-30336" "Icon"="imageres.dll,-5302" "InvokeCommandOnSelection"=dword:00000001 "MUIVerb"="@shell32.dll,-30329" "VerbHandler"="{f3d06e7c-1e45-4a26-847e-f9fcdee59be0}" "VerbName"="copyaspath" بعد تشغيل الاداة اضغط كلك يمين على اي ملف في الكومبيوتر او اي مجلد وستظهر لك: بعد نسخ اي مسار قم بلصقه، مثال: تحميل الملف من المرفقات لا تنسوني ووالدي من صالح دعائكم. تم بحمد الله. AddToRightClickWindows.rar

السلام عليكم، كثيراً ما ارى طلبات "كيفية عمل صلاحيات المستخدمين" قمت بعمل مثال بطريقة مبسطة جدا لكيفية عمل هذه الصلاحيات في تحديد فتح النماذج لمن لا يعرف ماذا اقصد بصلاحيات المستخدمين, مثال: اليوزر A غير مسموح له بفتح فورم الاعدادات مثلاً، اما اليوزر B مسموح له بفتح فورم الاعدادات اي سؤال انا موجود. تحياتي لكم Permission.accdb

السلام عليكم ورحمة الله وبركاته.. اقدم لكم النسخة الثانية من برنامج ادارة عيادة الطبيب.. تم تطبيق أغلب ملاحظاتكم وأقتراحاتكم في النسخة السابقة النسخة تجريبية تغلق بعد فترة الغرض من طرحها لمعالجة العيوب والأخطاء لكي يتم طرحها فيما بعد.. الرجاء منكم ابداء ملاحظاتكم واقتراحاتكم واضافاتكم وهل النسخة تحتوي على أخطاء؟ لكي اقوم بتحسين النسخة القادمة كلمة المرور لفتح البرنامج = 313 المميزات الحالية: 1- التصميم responsive يدعم جميع الشاشات الكبيرة والصغيرة 2- طباعة الوصفة الطبية 3- اضافة الادوية ومجاميعها والملاحظات 4- تسجيل بيانات المريض والحجوزات 5- تسجيل المصروفات 6- تعديل الاعدادات 7- اضافة نوع الحجز: * فحص = لإضافة الادوية للمريض * استشارة = لإرسال استشارة لطبيب آخر * دخول = لإرسال المريض الى المستشفى تصحيحات كثيرة وتعديل لأخطاء كثيرة قمت بها مع اضافة المزيد من الشروط لحصر وتقليل الأخطاء، شكرا لكل شخص ابدى رأيه وملاحظاته في النسخة السابقة، وايضا أنتضر ملاحظاتكم في هذه النسخة مع الشكر والتقدير doctor.rar

السلام عليكم ورحمة الله وبركاته.. اقدم لكم النسخة الأولى من برنامج ادارة عيادة الطبيب.. النسخة تجريبية تغلق بعد فترة الغرض من طرحها لمعالجة العيوب والأخطاء لكي يتم طرحها فيما بعد.. الرجاء منكم ابداء ملاحظاتكم واقتراحاتكم واضافاتكم وهل النسخة تحتوي على أخطاء؟ لكي اقوم بتحسين النسخة القادمة كلمة المرور لفتح البرنامج = 313 المميزات الحالية: 1- التصميم responsive يدعم جميع الشاشات الكبيرة والصغيرة 2- طباعة الوصفة الطبية 3- اضافة الادوية ومجاميعها والملاحظات 4- تسجيل بيانات المريض والحجوزات 5- تسجيل المصروفات 6- تعديل الاعدادات DOCTOR_FILES.rar

السلام عليكم.. في درس اليوم سنقوم بحساب نسبة الربح من سعر الشراء وسعر البيع وسنقوم بحساب سعر البيع من خلال نسبة الربح -------------------------------------------------------------------------------------- المثال الأول: إذا تم شراء سلعة بسعر 450 دولار، وبيعها بسعر 500 دولار، فما هي نسبة الربح؟ الحل: القانون الرئيسي لنسبة الربح: (الربح/سعر الشراء)×100% أولاً: نحسب قيمة الربح لكي نعوضها في القانون في الأعلى الربح = سعر البيع - سعر الشراء 500-450 = 50 دولار. وبالتعويض في القانون الرئيسي: نسبة الربح = (50/450) × 100% = 11.11% -------------------------------------------------------------------------------------- أما لو اردنا حساب سعر البيع من خلال نسبة الربح: المثال الثاني: إذا تم شراء سلعة بسعر 10 دولار وكانت نسبة الربح 25%، فما هو سعر البيع؟ الحل: القانون الرئيسي لحساب سعر البيع من خلال نسبة الربح: (سعر الشراء * نسبة الربح) / 100 + سعر الشراء وبالتعويض في القانون الرئيسي: النتيجة = (10 * 25) / 100 + 10 = 12.5 تحياتي لكم..

السلام عليكم.. في بلدي العراق لدينا أقل عملة نقدية وهي 250 دينار عراقي احفظو هذا الرقم جيداً لأننا سنعود اليه اردت ان اقوم بعمل برنامج للأقساط فكان مبلغ القسط الكامل هو ( 10,000 عشرة الآف دينار عراقي ) وكانت مدة الأقساط هي ( 3 شهور ) اذن نقوم بتقسيم المبلغ على المدة لكي يظهر لنا قيمة القسط لكل شهر وعند التقسيم ظهرت الكارثة مبلغ غريب!!!!!!!!!! فلا هو 250 دينار ولا هو 500 دينار لا يمكن دفعة.. ماهو الحل؟؟ قمت بكتابة كود لحل هذه المشكلة، للأمانة الكود ليس من كتابتي 100% بل بنسبة 60% Public Function RoundTo(d, roundRate, RoundType) As Double d = Math.Round(d, 7) If d <> 0 And roundRate <> 0 Then d = Ceiling(d) Dim num As Double num = d Mod roundRate If num > 0 Then If RoundType = 1 Then d = d + roundRate - num ElseIf RoundType = 2 Then d = d - num ElseIf RoundType = 3 Then If num >= roundRate / 2 Then d = d + roundRate - num Else d = d - num End If End If End If End If RoundTo = d End Function Public Function Ceiling(ByVal x As Double, Optional ByVal Factor As Double = 1) As Double ' X is the value you want to round ' Factor is the optional multiple to which you want to round, defaulting to 1 Ceiling = (Int(x / Factor) - (x / Factor - Int(x / Factor) > 0)) * Factor End Function الاستخدام: Private Sub cmd_calc_Click() Dim TotalPrice, Result As Long Dim Duration, i As Integer TotalPrice = 10000 Duration = 3 i = 1 Result = TotalPrice / Duration Do While i <= Duration MsgBox RoundTo(Result, 250, 2) i = i + 1 Loop End Sub ستظهر لنا النتيجة على شكل لووب مقسمة لإجزاء سيتم جبر النتيجة من 3,333333 الى 250 فتكون: 3,250 الف دينار لـ 3 دفعات ويمكنكم إستخدام الكود حسب العملة لديكم، بإستبدال 250 لإصغر قيمة عملة لديكم. تحياتي لكم

السلام عليكم.. اقدم لكم حيلة قديمة ربما تفيدكم.. على سبيل المثال: لدينا 3 حقول ( العدد 1 ) , ( العدد 2 ) , ( النتيجة ) وأريد ان اقوم بعملية جمع للحقلين 1 و 2 وعرض النتيجة.. الآن عند كتابة رقم في الحقل ( العدد 1 ) وبعدها كتابة رقم في الحقل ( العدد 2 ) تظهر النتيجة مباشرة بدون الخروج من الحقل بمعنى إعطاء النتيجة مباشرة اثناء الكتابة Private Sub textbox1_Change() textbox3.Value = Nz(textbox1.Text, 1) + Nz(textbox2, 1) End Sub الفكرة كلها في اضافة الـ Value لحقل عرض النتيجة والخاصية Text للحقل المراد سحب النتيجة منه. تحياتي لكم.

السلام عليكم، أحياناً تواجهنا مشكلة في الأكسس وهي تحول الارقام الى العربية خصوصاً اذا كان بجانب الرقم حروف عربية لذلك دعونا نختصر الوقت على العميل ونقوم بتعديل تنسيقات التاريخ والارقام..الخ برمجياً بدون الطلب من العميل تعديلها يدوياً اقدم لكم فنكشن للتعديل، يمكنكم التعديل والإضافة بحسب ماتجدوه مناسباً. Public Sub EditControlPanelInternational() 'Define a key registry path Dim strComputer Dim objRegistry Dim strKeyPath Dim strValueName Dim getValue Dim regKeyPath Dim strLocaleName, strCountry, strshortDateValue, strlongDateValue, strshortTimeValue, strlongTimeValue, strfirstDayOfWeekValue Const HKEY_CURRENT_USER = &H80000001 strComputer = "." Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") regKeyPath = "Control Panel\International" strLocaleName = "en-US" strCountry = "United States" strshortDateValue = "yyyy-MM-dd" strlongDateValue = "dddd, MMMM d, yyyy" strshortTimeValue = "h:mm tt" strlongTimeValue = "h:mm:ss tt" strfirstDayOfWeekValue = "6" srtnativedigits = "0123456789" objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "LocaleName", strLocaleName objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sCountry", strCountry objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sShortDate", strshortDateValue objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sLongDate", strlongDateValue objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sShortTime", strshortTimeValue objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sTimeFormat", strlongTimeValue objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "iFirstDayOfWeek", strfirstDayOfWeekValue objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sNativeDigits", srtnativedigits Debug.Print "Successfully changed system regional settings." End Sub للأمانة الفنكشن من كتابة saf لذلك انا قمت بإضافة السطر srtnativedigits = "0123456789" objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sNativeDigits", srtnativedigits لتغيير تنسيق الأرقام من عربي إلى انجليزي ومن ثم قمت بنقله لكم.

السلام عليكم ورحمة الله وبركاته،... كثيراً مانحتاج في برامجنا الى ( اسم مُدخل البيانات ) أي الذي قام بكتابة الفاتورة او تعديل أمر ما او طباعة ...الخ نريد أن نعرف من الشخص الذي قام بهذه العملية خصوصاً اذا كانت قاعدة البيانات قد تم ربطها بشكل شبكة ( سلسلة كومبيوترات متصلة بقاعدة البيانات ) كنا نستعمل الطريقة التقليدية أولا: بإنشاء جدول لتسجيل اسم المستخدم الحالي الذي يستخدم قاعدة البيانات في حال مروره بنموذج تسجيل الدخول ثانيا: نقوم بتخزينه في متغير Veriable من نوع String مثلاً وعند المرور بنموذج تسجيل الدخول يتم اسناد القيمة للمتغير في حال كان اليوزر والباسورد صحيحين Public CurrentUserName As String الكلام في الطريقتين صحيح، لكن في الطريقة الأولى سيبقى محتفظاً في اسم المستخدم حتى في حالة إغلاق الأكسس أجبارياً اما الطريقة الثانية فأن هذا المتغير سيفقد القيمة التي قمنا بتخزينها به عند ظهور أول رسالة خطأ من الأكسس جراء تطبيق أمر ما او أي عملية If قمت بكتابتها، بمجرد ظهور رسالة الخطأ ستختفي القيمة من المتغير CurrentUserName ونُصبح في مهب الريح ، حسناً لذلك سنقوم بإستخدام ( TempVars ) دعنا نسميها المخزن، نقوم بخزن اي قيمة بداخلها وتكون بهيئة ( Global Veriables ) يمكن استدعائها من أي مكان وسيتم تصفيرها بعد أغلاق الأكسس أجبارياً او إختيارياً ولن تمحى القيمة بعد ظهور رسالة خطأ كما أوضحت سابقاً. أضافة قيمة: TempVars.Add "CurrentUserName", "semo" إحضار القيمة: MsgBox TempVars("CurrentUserName") يمكنك إسناد الكثير من القيم لـ TempVars والإستفادة منها. لتفاصيل أكثر يمكنكم قراءة المقال من شركة مايكروسوفت: https://docs.microsoft.com/en-us/office/vba/api/access.tempvars.add أي سؤال أنا موجود، تحياتي لكم .

السلام عليكم ورحمة الله وبركاته، كيف حالكم اخواني الأفاضل. مبارك عليكم حلول شهر رمضان المبارك أعاده الله علينا وعليكم باليمن والخير والبركات. اقدم لكم فنكشن لإحتساب المدة بين تاريخين سنة - شهر - اسبوع - ساعة - دقيقة - ثانية سؤال: ما الفائدة من هذا الفنكشن؟ بالدرجة الأولى سيُفيد أصحاب برامج الأقساط والتقسيط لإحتساب فترات التأخير والإستحقاق وغيرها. وربما هنالك استخدامات أخرى له، حسب احتياج كل شخص الفنكشن: Public Function MainElapsedTime(d1, d2) As String d1 = CDate(d1) d2 = CDate(d2) vSecs = DateDiff("s", [d1], [d2]) MainElapsedTime = ElapsedTimeAsTextRecur(vSecs) End Function Public Function ElapsedTimeAsTextRecur(ByVal pvSecs, Optional ByVal pvSecBlock) 'recursive time lapse given seconds Dim vTxt Dim iNum As Long Const kDAY = 86400 Const kSECpYR = 31536000 '60 sec = 1 min = 60 sec '60 min = 1 hour = 3,600 sec '24 hour = 1 day = 86,400 sec '07 days = 1 week = 604,800 sec '30 days = 1 month = 25,92,000 sec '12 months = 1 year = 31,536,000 sec 'YEARS If IsMissing(pvSecBlock) Then pvSecBlock = kSECpYR iNum = pvSecs \ pvSecBlock Select Case pvSecBlock Case kSECpYR 'yr sUnit = "years" If iNum > 0 Then vTxt = iNum & " Years " pvSecs = pvSecs - (iNum * pvSecBlock) End If vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 2592000) Case 2592000 'MO sUnit = "months" If iNum > 0 Then If iNum > 11 Then iNum = 11 vTxt = vTxt & iNum & " Months " pvSecs = pvSecs - (iNum * pvSecBlock) End If vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 604800) Case 604800 'WEEK sUnit = "weeks" If iNum > 0 Then If iNum > 3 Then iNum = 3 vTxt = vTxt & iNum & " Weeks " pvSecs = pvSecs - (iNum * kDAY * 7) End If vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 86400) Case kDAY 'day sUnit = "days" If iNum > 0 Then vTxt = vTxt & iNum & " Days " pvSecs = pvSecs - (iNum * kDAY) End If vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 3600) Case 3600 'hrs sUnit = "hrs" If iNum > 23 Then iNum = 23 If iNum > 0 Then vTxt = vTxt & iNum & " Hours " pvSecs = pvSecs - (iNum * pvSecBlock) End If vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 60) Case 60 'min sUnit = "mins" If iNum > 0 Then vTxt = vTxt & iNum & " Minutes " pvSecs = pvSecs - (iNum * pvSecBlock) End If vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 1) Case Else sUnit = "secs" If pvSecs > 0 Then vTxt = vTxt & pvSecs & " Seconds" End Select ElapsedTimeAsTextRecur = vTxt End Function الإستخدام بسيط جدا في الإستعلامات او في النماذج او التقارير كالآتي: MainElapsedTime("Here your date", Date()) --------------------------------------------------- Example: MsgBox MainElapsedTime("6/3/2020", "14/4/2021") النتيجة: هنا انا قمت بمقارنة تاريخين فقط بدون أوقات، سأقوم الآن بمقارنة تاريخ مع وقت MsgBox MainElapsedTime("2/02/2019 12:07:16 pm", "13/04/2021 1:08:6 am") النتيجة: للأمانة الكود ليس من كتابتي 100%، فقط انا قمت بالتعديل عليه ليصبح بشكل افضل.. تحياتي وانتضرو مفاجئتي في الموضوع القادم

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته في هذا الدرس سأقدم نظرة عامة، ومُقدمة على التعابير القياسية Regular Expression وذلك لأهميتها الكبيرة في البرمجة. ملاحظة: لن اتطرق لكيفية كتابة الـ patterns نضرة لصعوبته على البعض لانه يحتاج اساسيات ومقدمات. في هذا الدرس سوف أستخدم بإذن الله لغة VBA في عمل اختبارات على الـ Regular Expression تعريف Regular Expression: هو كائن يصف نمطًا من المحارف ( أو الكلمات ). تعريف أعمق للتعابير القياسية: هي سلسلة من الأحرف التي تحدد نمطًا للبحث داخل النصوص (String) أو للمطابقة بين سلاسل من الأحرف. الهدف من التعاببير القياسية هو تسهيل عمليات البحث والاستبدال داخل النصوص، وتستخدم غالبًا في عمليات التحقق (Validation) وعمليات البحث (Searching) وايضًا في الحماية. ولتوضيح الفكرة بشكل أفضل بإمكاننا وضع مثال بسيط واقتراح الحلول له ثم بعد ذلك تبسيط الحل باستخدام التعابيير القياسية والتي سنرمز لها لاحقًا بـ RegExp. لنفرض أننا سنقوم ببرمجة نموذج تسجيل وستكون المدخلات المطلوبة ( اسم المستخدم - Username & البريد الإلكتروني - Email ) ونريد أن نتأكد من التالي: اسم المستخدم يجب أن يكون خليط من حروف وأرقام ، والرموز التالية فقط (_-.). البريد الإلكتروني يجب أن يكون بالشكل التالي : email_name@domain_name.top-level-domain مثال: cielblog@hotmail.com. وسيكون شكل نموذج التسجيل كالأتي: الحلول المقترحة كثيرة، مثلًا لكي نتأكد أن إسم المستخدم خالٍ من المسافات والرموز نحتاج لعمل تصفية (Filter) له، والتأكد اولًا من وجود مسافات واستبدالها مثلًا بالرمز _ او ازالتها كليًا، بعد ذلك تنقيح الاسم من الرموز الممنوعة ... عملية طويلة 🤔 اما البريد الإلكتروني يجب ان نتأكد اولًا من خلوه من المسافات ايضًا، والرموز الممنوعة في اغلب مشغلات البريد الإلكتروني، بعد ذلك التحرك قليلًا للتأكد أنّ ماقبل علامة @ هو String ومابعده String ثم التحقق أن ماقبل علامة النقطة - dot - هو String ومابعده هو top-level-domain ... عملية أطول 🤔 في التعابيير القياسية يمكننا اختصار كل هذه العمليات بسطر واحد أو نصف سطر حتى، وفي درسنا هذا سنتعلم كيف نحل مشكلتنا هذه ان شاء الله. أولاً: انسخ الفنكشن الآتي.. ' ----------------------------------------------------------------------' ' Return True if the given string value matches the given Regex pattern ' ' ----------------------------------------------------------------------' Public Function RegexMatch(value As Variant, pattern As String) As Boolean If IsNull(value) Then Exit Function ' Using a static, we avoid re-creating the same regex object for every call ' Static regex As Object ' Initialise the Regex object ' If regex Is Nothing Then Set regex = CreateObject("vbscript.regexp") With regex .Global = True .IgnoreCase = True .MultiLine = True End With End If ' Update the regex pattern if it has changed since last time we were called ' If regex.pattern <> pattern Then regex.pattern = pattern ' Test the value against the pattern ' RegexMatch = regex.test(value) End Function لاحظو الفنكشن يتكون من براميترات 2 الأول القيمة المراد اجراء التحقق عليها والبراميتر الثاني هو معيار التحقق ولو اردت ان اكتب تحقق لإسم المستخدم، سأكتب: If RegexMatch("semo", "^[\w_-]+$") = True Then MsgBox "Correct username", vbInformation, "CORRECT" Else MsgBox "Wrong username", vbCritical, "ERROR!" End If لو اردت ان اكتب تحقق للبريد الإلكتروني سأكتب: If RegexMatch("test@gmail.com", "[A-Za-z0-9_\-.]+@[A-Za-z0-9_\-.]+\.(com|org|net)") = True Then MsgBox "Correct email", vbInformation, "CORRECT" Else MsgBox "Wrong email", vbCritical, "ERROR!" End If للفائدة، google ممتلئ بالـ patterns ماعليك فقط ان تبحث قليلاً وستجد الباترن المطلوب ☺️ بالتوفيق للجميع.

السلام عليكم ورحمة الله وبركاته.. الكثير يجهل امكانية الأكسس في جعل البرامج بشكل responsive أي انه: لو كانت لديك شاشة كبيرة سيتغير شكل برنامجك وتوزيع الأزرار والعناصر لتتناسب مع حجم الشاشة ولو كانت الشاشة صغيرة ايضا ستتغير اماكن العناصر لكي تتناسب مع طبيعة الشاشة وعدم فقدان أي عنصر او ضياعه عندك تغيير الشاشات. قبل البدء، سأقدم لكم مثال على ما اقصده: هذا اخر مشاريعي في الأكسس وهو يتغير تبعاً لأختلاف الشاشات. لنبدأ: سأقوم بوضع Button في منتصف الشاشة بحيث لا يتغير مكانه لو تغير حجم الشاشة ثم قم بعملية الأدراج من جميع الأماكن ( يسار, يمين, أعلى , أسفل ) بحيث يصبح كالأتي: ثم من الطرف اليمين، نختار الأرتساء الأفقي ( كلاهما ) وكذلك الحال بالنسبة لليسار كذلك الحال نطبق على الأعلى والأسفل لكن هذه المرة سوف نعدل الأرتساء العمودي وكذلك بالنسبة للأعلى جرب الآن وسوف ترى ان الـ Button سيبقى في الوسط مهما تغير حجم الشاشة لو وضعت شاشة كبيرة أو صغيرة سيظل بنفس مكانه في الوسط. أي سؤال أنا موجود، تحياتي لكم.

السلام عليكم، لو اردنا ان نقوم بحفظ السجلات المحددة في النموذج الفرعي سنلجئ لعمل CheckBox في الجدول ومن ثم نقوم بعمل استعلام يقوم بفلترة جميع الـ Checkbox التي تكون قيمتها True ومن ثم نقوم بحفظها. لكن! ماذا لو كانت قاعدة البيانات تعمل بنظام الشبكة ( Multi Users ) اذا قام المستخدم رقم 1 بوضع علامة صح على مثلا مادة ( برتقال ) وقام المستخدم رقم 2 بوضع علامة صح على مثلا مادة ( رمان ) عندما يضغط اي مستخدم على حفظ البيانات فـ ستحفظ البيانات وتكون النتيجة خاطئة لان البيانات ليست هي المطلوبة انا اخترت ( برتقال ) فأتتني النتيجة ( برتقال + رمان ) وكذا بالنسبة للمستخدم الثاني والثالث وغيرهم، ممن يعملون على قاعدة البيانات بوقت واحد، صراحة واجهتني هالمشكلة لكن وجدت الحل لها كما انني رأيت موضوع للأخ ابا جودي يتكلم عن هذه المشكلة ارفقت لكم طريقة مختلفة في تحديد السجلات وهي الضغط على مُحدد السجلات للأمانة الطريقة ليست كلها من برمجتي الحقوق لـ arnelgp انا فقط قم اضافة وتعديل بعض الامور البسيطة تحياتي لكم RecordSelectorClick.accdb

السلام عليكم.. في البداية شكرا لكل من قام بالرد على موضوعي السابق في وقتنا الحاضر ارى ان اغلب البرامج في السوق هي من هذا النوع وللأسف لم اجد التفاعل الكبير معها، خصوصا في موضوعي في الأعلى عموما، قمت ببرمجة برنامج صغير لإدارة المخزن، وانتضر منكم التجربة للوقوع على الأخطاء ومحاولة تصحيحها علماً، ان النسخة مؤقتة وسوف تُغلق بعد تصحيح الأخطاء. باسورد فتح البرنامج = 313 تحياتي للجميع. store_manager.rar

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

السلام عليكم ورحمة الله وبركاته.. اليوم سأشرح لكم الدالة StrConv ولأي الامور تستخدم. الدالة حصرا تتعامل مع النصوص ( String ) ووضيفتها التحويل بين الاحرف الانجليزية ( كبير , صغير ) الدالة تأخذ 3 براميترات: البراميتر القيمة الوصف vbUpperCase 1 تحويل جميع الحروف الى حروف كبيرة vbLowerCase 2 تحويل جميع الحروف الى حروف صغيرة vbProperCase 3 تحويل الحرف الاول من كل كلمة الى كبير وباقي حروف الكلمة الى حروف صغيرة vbUnicode 64 تحويل النص الى سلسلة الـ UNICODE vbFromUnicode 128 تحويل النص من سلسلة UNICODE الى تنسيقات اخرى مثال: StrConv ("officena semo pa3x", 1) Result: "OFFICENA SEMO PA3X" StrConv ("OFFICENA SEMO PA3X", 2) Result: "officena semo pa3x" StrConv ("OFFICENA SEMO PA3X", 3) Result: "Officena Semo Pa3x" الاستخدام في الاستعلام يكون: الاستخدام في داخل محرر الـ VBA يكون: StrConv([CategoryName],3) تحياتي للجميع.. SEMO.Pa3x

في كثير من الاحيان، نلجأ الى استخدام الدالة IF أو غيرها من دوال الشروط للتحقق من قيم رقمية. ملاحظة: الدالة تتحقق من الارقام فقط. مثلا لو كان الحقل يتحوي القيمة 1 اظهر لي رسالة جيد واذا كان الحقل يحتوي القيمة 2 اظهرلي رسالة متوسط واذا كان الحقل يحتوي القيمة 3 اظهر لي رسالة ضعيف في الوضع الطبيعي VBA داخل النماذج يكون If txt_Status = 1 Then MsgBox "جيد" ElseIf txt_Status = 2 Then MsgBox "متوسط" ElseIf txt_Status = 3 Then MsgBox "ضعيف" Else MsgBox "لا توجد قيمة مطابقة" End If وفي الاستعلام يكون Check_Value: IIf([text_Status]=1;"جيد";IIf([text_Status]=2;"متوسط";IIf([text_Status]=3;"ضعيف";"لا توجد قيمة مطابقة"))) اما الدالة Choose مختصرة وسهلة اكثر. Nz(Choose(txt_Status, "Good", "Semi-Good", "Bad"), "No Value !") تقوم الدالة بعرض مكان القيمة الصحيحة بين القيم الموضوعه حسب الحقل الموجود txt_Status تحياتي لكم. حسنين

السلام عليكم ورحمة الله وبركاته.. في الوضع الطبيعي الاكسس يعطينا فقط مجموعة الوان عند تنسيقها في الكود Constant Value Description vbBlack 0x0 Black vbRed 0xFF Red vbGreen 0xFF00 Green vbYellow 0xFFFF Yellow vbBlue 0xFF0000 Blue vbMagenta 0xFF00FF Magenta vbCyan 0xFFFF00 Cyan vbWhite 0xFFFFFF White ولكن كثيراً ما نريد ان نقوم بإختيار الواناً غير التي موجودة في الاعلى مثلا اللون الفسفسوري غير موجود في القائمة. قمنا باخذ قيمة اللون الفسفوري من احد برامج تعديل الصور وليكن مثلا الفوتوشوب لكن احيانا تواجهنا مشاكل ورسائل مزعجة من الاكسس عند وضع الالوان عن طريق VBA مثلا انا دائما ماكانت تصادفني رسالة مزعجة Expected Array عندما اقوم بوضع اللون بالصورة الاتية: txt_name.BackColor = RGB(20,30,60) تظهرلي هذه الرسالة: فكرت في تحويل اللون من HEX الى OLE ، وقد تم تغيير اللون بنجاح وبدون اي رسائل خطأ Public Function HEX2OLE(ByVal hexValue As String) As Long Dim R, G, B As Long If Left(hexValue, 1) = "#" Then hexValue = Replace(hexValue, "#", "") R = CByte("&H" & Left(hexValue, 2)) G = CByte("&H" & Mid(hexValue, 3, 2)) B = CByte("&H" & Mid(hexValue, 5, 2)) HEX2OLE = CLng(R + (G * 256) + (B * 65536)) End Function بالتوفيق للجميع. HEX_2_OLE.accdb