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

وعليكم السلام ورحمة الله وبركاته هذه الوظيفة تشفر الصورة بنقرة ، وبالنقرة الثانية تفك التشفير يمكنك ادراجها عند جلب الصور وكذلك عند عرضها المهم ان تضعها في مكانها المناسب Private Sub zer1_Click() EcryptDcryptImage ([CurrentProject].[Path] & "\image1" & ".jpg") End Sub Public Sub EcryptDcryptImage(sFileSpec As String) Dim iFle As Long Dim iByteCount As Long Dim i As Long Dim ii As Byte iFle = FreeFile Open sFileSpec For Binary As iFle iByteCount = LOF(iFle) For i = 1 To iByteCount Get iFle, i, ii ii = ii Xor &HFF Put iFle, i, ii Next i Close iFle If UCase$(Right$(sFileSpec, 1)) = "." Then Name sFileSpec As Left$(sFileSpec, Len(sFileSpec) - 1) Else Name sFileSpec As sFileSpec & "." End If End Sub

https://drive.google.com/file/d/16wPjc1F9pyCAZLQN7Ap3qcUOKOZ8bBMa/view?usp=drivesdk البرنامج مضغوط في ملف للتحميل من الرابط ويوضع في قرص D رمز المرور 1 التنزيل من درايف draiv

كود رائع اخوي ابو ابراهيم ، تغوص في الاعماق من مجلد فرعي الى آخر 🙂 جعفر

وعليكم السلام رحمة الله أهلا بك @النجاشي أجريت تعديلا على بعض الإجراءات.. وأنشأت لك وظيفة تقوم بالبحث عن اسم الملف أبتداءً من الدليل الرئيسي إلى أدنى مستوىً من الأدلة الفرعية. فإن كان الملف موجودا؛ أعادة اسم الملف مع الدليل.. الوظيفة مع التعديلات Public Function XPath() XPath = CurrentProject.Path & "\src\" End Function Public Function FSO() As FileSystemObject Set FSO = New FileSystemObject End Function Public Function GetFileDirectory(MainPath As Object, Optional FileName As Variant) Dim OFIL As Scripting.File, OFILS As Scripting.Files Dim OMFD As Scripting.Folder, OSFD As Scripting.Folder Static XFileName As String, FilePath '.. Static Declaration reserved value when function recoll '-- get filename in first time call and reserved value If Not IsMissing(FileName) Then XFileName = FileName End If '-- loop for subfolders in his parent folder For Each OSFD In MainPath.SubFolders Set OMFD = FSO.GetFolder(OSFD.Path) Set OFILS = OSFD.Files '-- loop for file in each folder For Each OFIL In OFILS If OFIL.Name = XFileName Then FilePath = OFIL.Path GoTo TheEnd End If Next '-- Function recoll himself with subfolder GetFileDirectory OSFD Next TheEnd: '-- Function return filepath if file found GetFileDirectory = FilePath End Function اظهار المرفقات .zip

السلام عليكم 🙂 الظاهر هذا موسم الترقيات ، فرجاء تهنئوا معي اخواي @ابو البشر و @kkhalifa1960 على ترقيتهم لرتبة خبير 🙂 لازلنا نبحث لنزيد رصيد المنتدى من الخبراء 🙂 جعفر

السلام عليكم ورحمة الله وبركاته الحمد لله والصلاة والسلام على رسول الله وعلى آلة وصحبه، أما بعـد: أمل ان لا أكون خالفت أنظمة وشروط المنتدى بطرحي هذا فقد قمت بجمع عدد ليس بالقليل من الأمثلة التي قد يستفيد منها المبتدئين وسوف أقوم بتنزيلها على مجموعات لعدم إمكانية رفعها دفعة واحدة و بعد التأكيد من موافقة إدارة المنتدى سوف نضع بين ايديكم المجموعة الأولى والثانية من الأمثلة التي تناسب مع المبتدئين ونسأل الله بعد الموافقة انها تكون مفيدة لكل مبتدي تحياتي

مرفقك لم يعمل عندي لاني أعمل على أكسس 10 ولكن تفضل ووافني بالرد D912.accdb

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

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

والله روعة روعة روعة تسلم ايدك

هذا الموضوع مهم بالنسبة للمحاسبين ...وبما اني لست محاسبا ومع الاسف فلم اهتم لهذا الموضوع كثيرا انظر هذا الفيديو للاستاذ مؤمن سالم ...واعتقد انه احد اعضاء منتدانا العزيز

عليكم السلام جرب كما في الصورة

مرفقك لم يعمل عندي ولكن ممافهمت تفضل ووافني بالرد D911.accdb

اخي الكريم ... لا تزعل من مناقشتي لك ... فقط ليطمأن قلبي ... والامر متروك لاحد المشرفين ان اذن فأبشر بالباس ننتظر السيد @jjafferr او السيد @أبو إبراهيم الغامدي اعطوني رأيكم حتى لا نخالف قوانين المنتدى

تفضل( مع العلم أن الملف ليس لي ، وأضنه من إبداعات أحد أعضاء المنتدى ) 🙂 : حالة الاتصال بالنت.accdb

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

جرب هذا الكود اخى Option Explicit '//////////////////////////////////////////////////////////////////// 'Password masked inputbox 'Allows you to hide characters entered in a VBA Inputbox. ' 'Code written by Daniel Klann 'March 2003 'https://stackoverflow.com/questions/28189864/excel-vba-input-box '//////////////////////////////////////////////////////////////////// 'API functions to be used Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long 'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If 'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function Function InputBoxDK(Prompt, Title) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title) UnhookWindowsHookEx hHook End Function ولكن من الاسهل كما قال لك اخى @عبدالفتاح في بي اكسيل استخدم userform قم بإنشاء userform يحتوي على مربع نص وزر في خصائص مربع النص ، أدخل * في مربع PasswordChar Box كما بالصورة وفي كود الزر ضع الكود الخاص بك في اول الموضوع

وعليكم السلام ورحمه الله وبركاته اخى @spyhearts ضع هذا في UserForm1 وجرب كتابه اي تاريخ ميلادي سوف يعطيك تاريخ اليوم هجرى اما ان كتبت التاريخ هجري سوف يكتبه لك كما كتبته Private Sub TextBox11_AfterUpdate() If Year(TextBox11.Value) > 1500 Then a = Format(TextBox11.Text, "0") TextBox11.Value = "" MsgBox "هذا ليس تاريخ هجري " VBA.Calendar = vbCalHijri TextBox11.Text = Format(a, "[$-1170000]yyyy-mm-dd;@") End If End Sub وايضا اخى كل طلب يكون له موضوع مستقل ليكون مرجع وللاستفادة المستقبليه للاعضاء

بارك الله فيك استاذي الفاضل@أبو إبراهيم الغامدي ابو ابراهيم وشكر كثير على مجهودك فعلا رائع وجميل وهو المطلوب فالف الف شكر وجزاء الله خير الجزاء وزادك علما تحياتي

@Osama-2020 سهل الامور على نفسك واستخدم اليوزرفورم من خلال خصائص التيكست بوكس ستجد مرادك .

بل الشكر لله ثم لكم اخوانى واساتذتى فلولا ما قدمتموه لنا ما تعلمنا شىء فجزاكم الله عنا كل خير 💐🌷 تقبل تحياتى اخى ومعلمى العزيز جعفر

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

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

سيتم النقل لقسم الاكسيل ، للحصول على فرصة اكير للاجابة

وتنسيب البرامج الى صاحبها ، او الى رابط الموضوع اللي كانت فيه 🙂 جعفر

هل قصدك انك تريد تغير دقة شاشة وندوز المستخدم الى 1024*768 . ومع امكانية عمل هذا ، فلا انصح بهذا العمل ، فستصادفك مشاكل اخرى ، وانا من المسخدمين اللي ما اسمح لأحد ان يلعب باعدادات الوندوز في كمبيوتري 🙂 جعفر

شكرا جزيلا اخوي ابوبسمله على المحاولة ، وايجاد الحل 🙂 قبل ان اضع مشاركتي السابقة ، كنت قد حاولت المحاولات التالية ، ولم يستجب/يقبل البرنامج : بعمل تغيير على التقرير وحفظه ، عمل برنامج جديد ، واستيراد جميل كائنات البرنامج القديم اليه ، تصدير التقرير الى ملف نص عن طريق الامر application.SaveAsText (حتى استورده مرة اخرى للبرنامج بغسم آخر ، عن طريق الامر Application.LoadFromText) ، وبعد وضع المشاركة السابقة واغلاق الكمبيوتر ، جاء في بالي عمل حدث في التقرير ، ولا ادري اذا كان سيحل المشكلة 🙂 جعفر

بسم الله نبدأ عامنا الحالي بهذه الموسوعة 1200_Visual_Basic_macro_examples.rar عسى أن ينال إعجابكم

شكرا د. جمال في ميزان حسناتك ... ونفعنا الله بعلمك .. وجزاك عنا خير الجزاء في الدنيا والاخرة

الله يعافيك اريد عند غلق النموذج يتم طباعة التقرير المرفق تلقائيا بدون تدخل مني وليكن مثلا على سطح المكتب ويكون اسم التقرير 17-12-2022.. وفي الغد يكون التقرير باسم 18-12-2022 .. وهكذا وهكذا بحيث في نهاية الاسبوع يكون لدي ارشيف وشكرا لك

بعد اذم المهندس قاسم استاذى ومعلمى اتفضل اخى الحل عند طريق دالة DLookUp فى التقرير وليس فى الاستعلام تحياتى 1.rar

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

شكرا دكتور برنامج سهل متكامل ، الجميل فيه : العمل من خلال شاشة واحدة

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

شكرا جزيلا على المشاركة 🙂🌷

إذا القضية تكمن في آلية تصميم الجداول وربطها مع بعضها بالعلاقات المناسبة .. ولن تحتاج إلى فعل ذلك بالأكواد .. 🙂 وهذا الأمر هو من أساسيات عمل قواعد البيانات .. لا يتم تكرار البيانات في الجداول بل يتم اختصارها وتنظيمها وربطها بعلاقات .. ضع أنت المثال كمرفق وسيتم التعامل معه من قبل الشباب المبدعين إن شاء الله.. 🙂🌹

طيب جرب المرفق حسب فهمي للموضوع ........ قاعدة بيانات.rar

الجدول الذي عليه علامة + سيصبح هو المصدر كما في تقسيم قاعدة البيانات التي تصبح فيها احدى القواعد عبارة عن جداول فقط والقاعدة الثانية فيها النماذج والاستعلامات والتقارير

السلام عليكم مشاركه مع اخوانى واساتذتى جزاهم الله عنا كل خير معلمى العزيز جعفر قد تذكرت لك رد ع موضوع على ما اتذكر كان فى موضوع باسم التقرير الشبح فقمت بتنزيل المرفق والاطلاع عليه ولكن لم اجد الشبح 😀 ولكنى وجدت التالى فالخصائص يتضمن وحده نمطيه مفعله بنعم فقمت بتغييرها الى لا وتم تعديل التقرير والحفظ قمت بالتعديل رقم 4 فقط وركت الاخر تقبلوا تحياتى وجزاكم الله عنا كل خير oiu_1.accdb

السلام عليكم ورحمة الله وبركاته وبها نبدأ اي موضوع اخى @kassem_geo

تفضل اخي Sheet_name.xlsb

وعليكم السلام ورحمة الله وبركاته أتوقع باستخدام الدالة (INDIRECT) ولعل هذا هو المطلوب 😘 نموذج (1).xlsx

هذي النقطة أعتقد ليس لها علاقة بالكود وإنما بتضبيطات بريد الياهو عندك .. فقد حصلت معي سابقا .. ****************************************************************************************** هذا السطر الذي ذكرته لك ( أزل الرمز ( ' ) من أمامه) : وبعد التفعيل تم ارسال المرفق بنجاح : ****************************************************************************************** وبالنسبة لفحص الاتصال بالانترنت استخدم هذا الكود (يوضع في موديول عام) : #If VBA7 Then Private Declare PtrSafe Function InternetGetConnectedState Lib "wininet.dll" _ (ByRef dwFlags As Long, _ ByVal dwReserved As Long) As Boolean #Else Private Declare Function InternetGetConnectedState Lib "wininet.dll" _ (ByRef dwFlags As Long, _ ByVal dwReserved As Long) As Boolean #End If Function Is_Connected() As Boolean Dim IEStat As Long Is_Connected = (InternetGetConnectedState(IEStat, 0&) <> 0) End Function Public Sub TestInternetConnection() If Is_Connected() = True Then MsgBox "Connected" Else MsgBox "Not Connected" End If End Sub ثم يتم استدعاء أحد الدالتين التاليتين : Connected() هذه تعطيك نتيجة نعم/ لا على الإتصال TestInternetConnection() وهذه تظهر لك رسالة تخبرك إن كان متصل أم لا ****************************************************************************************** وأنا أريدك أن تتعلم كيفية التعامل مع الأكواد أخي @حمدى الظابط 🙂

السلام عليكم ورحمة الله وبركاته نضع بين ايديكم المجموعة الأولى وهي عبارة عن عدد 12 مثال وكذلك المحموعة الثانية وهي عبارة عن عدد 12 مثال وكذلك المحموعة الثالثة وهي عبارة عن عدد 12 مثال من الأمثلة التي يتجاوز 12 مجموعة واعتذر لكل من لة مثال تم تنزيلة بدون استيذان ولكن الهدف هو الفائدة ولكم خالص التحية المجموعة الاولى.rar المجموعة الثانية.rar المجموعة الثالثة.rar

مجرد تخمين Sub kh_RngProper() Dim Cel As Range Dim ws As Worksheet For Each ws In Worksheets For Each Cel In ws.UsedRange Cel.Value = StrConv(CStr(Cel), vbProperCase) Next Next ws End Sub

المشكلة هيا ان المايكرو يعتمد على موضع الماوس في الحذف لذا هو يحذف ذيل الفاتورة وليس الفاتورة نفسها ,, على العموم احذف الزر الذي قمت بعمله وستخدم زر جديد وضع فيه هذا الكود قمت بتعديل اسم حقل رقم الفاتورة داخل الجدول الى INVOID وايضا قمت بتعديل اسم الحقل في النموذج الى INVONO . نصيحة اخيرة استخدم التسميات الانكليزيه ولا تضع مسافات بين التسميات لانها تسبب كل الكثير من الصداع لو احبب ان تضع مسافه استخدم _ لتجنب المشاكل من هذا النوع , بالتوفيق ان شاء الله On Error Resume Next DoCmd.SetWarnings False DoCmd.RunSQL ("DELETE * FROM فاتورة WHERE [INVOID] = " & Me.INVONO & "") MsgBox "Êã ÍÐÝ ÇáÝÇÊæÑÉ" DoCmd.SetWarnings True Me.Requery

شغل عالى عالى تسلم ايدك ورحم الله والديك ووسع الله فى رزقك

السلام عليكم هذا هو السطر المقصود .Range("A2:S2").AutoFilter Field:=4, Criteria1:=">=" & myDate1, Operator:=xlOr, Criteria2:="<=" & myDate2 تم تغير الجزء xlOr الى xlAnd

السلام عليكم هل تقصد هكذا بحث بين تاريخين.rar

الاخوه الاعزاء الموضوع الذي اتقدم به اليوم هو كيفية عمل نسخه احتياطيه للملف في اكثر من درايفر( c,d f,e) الرجاء قراءة الشرح قبل تحميل المرفق اولا: يوجد بالمرفق فولدرين تحت اسم (ahmad 1,ahmad 2) بالاضافه للملف الاصلي نظرا لانه عند تنزيل الويندوز في بعض الاحيان تختلف تقسيمات الدرايفرز فانني اخترت تنفيذ النسخه الاحتياطه في درايفر c , d اما من لديه اربع درايفرات فيمكنه عمل نسخ احتياطيه اخرى في درايفر f , e بسهوله ثانيا: الية عمل النسخه كلاتي 1 حفظ الملف الاصلي 2 عمل نسخه احتياطيه في كل من درايفر c ,d وهذا طبعا عند اختيار yes اما عند اختيار no فانه سيعمل فقط على حفظ الملف الاصلي فقط دون عمل تحديث للنسخ الاحتياطيه ثالثا: المطلوب حتى يتم تنفيذ العمل بالشكل الصحيح 1 نقل فولدر ahmad 1 الى درايفر c 2 نقل فولدر ahmad 2 الى درايفر d 3 نقل الملف الاصلي الى اي مكان ترغب به رابعا: طريقة التنفيذ 1 فتح الملف الاصلي المرفق 2 النقر على زر النسخه الاحتياطيه والانتظار قليلا حتي يتم التنفيذ ويتم غلق الملف تلقائيا 3 الذهاب الى فولدر ahmad 1,ahmad 2 ستجد الملف موجود هناك 4 العوده الى الملف الاصلي ومحاولة كتاب اي شئ به ومن ثم النقر على الزر مره اخرى ( اختياري) 5 الذهاب الى فولدر ahmad 1,ahmad 2 ستجد التغيرات التي تمت في الملف الاصلي هي نفسها الموجوده في النسخ الاحتياطيه خامسا : محظورات الاستخدام 1 يجب دائما استخدام الملف الاصلي ولا يمكن باي حال استخدام ملفات النسخ الاحتياطيه كملف اصلي الا في الحالات التاليه: أ في حالة فقدان الملف الاصلي واردت ان تستخدم النسخ الاحتياطيه فقم بفتح ملف النسخه وقم بعمل حفظ باسم الى اي مكان تريده وفي هذه الحاله يعتبر الملف الذي قمت بعمل حفظ باسم له هو الملف الاصلي الذي ستعمل به ب كما يمكن ايضا استخدام ملف النسخ كملف رئيسي ولكن دون استخدام زر الامر (نسخه احتياطيه)والاكتفاء فقط بحفظ الملف لانه بطبيعة الحال لا يمكن عمل نسخه احتياطيه لملف النسخه نفسها سادسا : التغييرات المسموح بها 1 يمكنك تغيير اسماء الفولدرز الى اي اسم تريده ولكن بشرط ان تغير الاسم الموجود بالكود نفسه 2 وحتى ان اردت ان تضع الفولدر داخل فولدر فيمكن هذا ولكن ايضا بشرط ان يتم نقل path ووضعه كما هو بالكود بين علامات التنصيص سابعا : مبروك عليكم حلول عيد الفطر السعيد( وكل عام وانتم بخير) نسخه احتياطيه.rar