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

السلام عليكم ورحمة الله تعالى وبركاته يواجه الكثير من المصممين مشكلة اختلاف اللغة او بمعنى ادق يريد الكثير ان تكون لغة الازرار والتطبيق والرسائل موحدة وهذا ما لا يحدث عندما تكون نسخة الويندوز مثلا انجليزية والتطبيق بمصمم باللغة العربية او حتى يكون التعبير اكثر دقه عندما تختلف لغة واجهة المستخدم فى الويندوز عن اللغة التى يريد المصمم ان تظهر بها كل كبيرة وصغيرة قى التطبيق بما فيها ازرار الرسائل مثال لكى تكون الصورة اكثر وضوحا الرسالة بالعربى وهنا يريد المصمم ان تكون لغة الازرار كذلك بالعربى ولكن لغة واجهة الاستخدام انجليزية وعنوان الزر يظهر تبعا للغة الويندوز تم التغلب عليها مسبقا باستخدام دوال الـ API ولست بصدد الحديث عنها لان بها قيد وهو - شرط لان يتم تغيير اسماء الازرار فى صندوق الرسائل بالاسماء التى يرغب بها المستخدم ان تكوت الخصيصة pop up للنموج = No وهذا فيه تقييد للمصمم وخاصة ان كان يستخدم هذه الخصيصة بالشكل التالى pop up للنموج = Yes وكان الحل البديل هو عمل نموذج للرسائل بدلا من استخدام صندوق الرسائل واعتقد تم عمل ذلك مسبقا فى المنتدى ولكن انا الان اقدمه بافضل اسلوب احترافى واكثر مرونه. لعمل ذلك اولا قم بتصميم نموذج للرسائل واعطه الاسم : frmCustomMessageBox وان اردت تغيير الاسم قم بالتسمية التى تناسبك مع مراعاة تغيير الاسم كذلك فى الكود الذى سوف اقدمه بعد قليل والمستخدم فى الوحدة النمطية العامة الان افتح نموذج الرسائل "frmCustomMessageBox" فى وضع التصميم اضف العناصر التاليه عدد 5 عنصر "Buttons" أزرار أوامر على ان تكون الاسماء للازرار كالتالى : Button0 , Button1 , Button2 , Button3 , Button4 عدد 1 عنصر "Labels" عنوان : على ان يكون اسمه كالتالى : MessageLabel عدد 1 عنصر "Image" صورة : على ان يكون اسمه كالتالى : IconImage والان اضف وحدة نمطية عامة واعطها مثلا الاسم : basCustomMessageBox اضف اليها الكود التالى ' متغير لتخزين رقم الزر الذي تم الضغط عليه في نموذج الرسائل المخصص. Private intPressedButton As Integer ' دالة لعرض صندوق رسائل مخصص ' Parameters: ' - arrMessageLines: مصفوفة تحتوي على أسطر الرسالة. ' - strTitle: عنوان صندوق الرسائل. ' - strButtons: قائمة أزرار مفصولة بفواصل. ' - arrTooltips: مصفوفة تحتوي على تلميحات للأزرار (اختياري). ' - strIconPath: مسار الأيقونة (اختياري). ' Returns: ' - رقم الزر الذي تم الضغط عليه (بدءًا من 0 إلى 4)، أو -1 في حالة حدوث خطأ. Function MsgBx(arrMessageLines As Variant, strTitle As String, strButtons As String, Optional arrTooltips As Variant = Null, Optional strIconPath As String = "") As Integer On Error GoTo ErrorHandler Dim frmCustomMsgBox As Form Dim ctrlCurrent As Control Dim strButtonCaption As Variant Dim intButtonIndex As Integer Dim arrButtonCaptions As Variant Dim strMessage As String Dim strLine As Variant Dim strFormName As String strFormName = "frmCustomMessageBox" ' بناء الرسالة من الأسطر الممررة strMessage = "" For Each strLine In arrMessageLines If strMessage <> "" Then strMessage = strMessage & vbCrLf ' إضافة سطر جديد بين الأسطر End If strMessage = strMessage & strLine Next strLine ' التحقق إذا كان النموذج مفتوحًا If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> 0 Then ' إذا كان النموذج مفتوحًا، فقط استعد المرجع إليه Set frmCustomMsgBox = Forms(strFormName) Else ' إذا لم يكن مفتوحًا، افتحه DoCmd.OpenForm strFormName, acNormal, , , , acHidden Set frmCustomMsgBox = Forms(strFormName) End If ' إعداد خصائص النموذج With frmCustomMsgBox .Caption = strTitle .Controls("MessageLabel").Caption = strMessage ' إظهار التسمية فقط إذا كان هناك نص .Controls("MessageLabel").Visible = (strMessage <> "") ' إضافة الأزرار الجديدة بناءً على strButtons intButtonIndex = 0 arrButtonCaptions = Split(strButtons, ",") For Each strButtonCaption In arrButtonCaptions With .Controls("Button" & intButtonIndex) .Caption = strButtonCaption .Visible = True .OnClick = "=PressedButton(" & intButtonIndex & ")" ' تعيين التلميحات للأزرار إذا تم تمريرها If Not IsNull(arrTooltips) And IsArray(arrTooltips) Then If intButtonIndex <= UBound(arrTooltips) Then .ControlTipText = arrTooltips(intButtonIndex) End If End If End With intButtonIndex = intButtonIndex + 1 Next strButtonCaption ' تعيين الأيقونة إذا كان مسارها موجودًا If strIconPath <> "" Then If Dir(strIconPath) <> "" Then ' إذا كانت الأيقونة موجودة، قم بتعيينها On Error Resume Next ' تجاهل الخطأ إذا حدث .Controls("IconImage").Picture = strIconPath If Err.Number <> 0 Then ' إذا حدث خطأ، أخفي عنصر التحكم .Controls("IconImage").Visible = False Err.Clear Else .Controls("IconImage").Visible = True End If On Error GoTo ErrorHandler ' العودة إلى إدارة الأخطاء العادية Else ' إذا لم تكن الأيقونة موجودة، أخفي عنصر التحكم .Controls("IconImage").Visible = False End If Else ' إذا لم يتم تمرير أيقونة، أخفي عنصر التحكم .Controls("IconImage").Visible = False End If End With ' إظهار النموذج كمودال DoCmd.OpenForm strFormName, acNormal intPressedButton = -1 ' انتظار المستخدم لتحديد زر Do DoEvents Loop Until intPressedButton > -1 ' إرجاع القيمة وإغلاق النموذج DoCmd.Close acForm, strFormName, acSaveNo MsgBx = intPressedButton Exit Function ErrorHandler: ' إرجاع قيمة تشير إلى فشل العملية MsgBx = -1 MsgBox "حدث خطأ: " & Err.Number & " | " & Err.Description Debug.Print "حدث خطأ: " & Err.Number & " | " & Err.Description Exit Function End Function Function PressedButton(intButtonIndex As Integer) ' تسجيل الرقم الخاص بالزر المضغوط intPressedButton = intButtonIndex End Function والان طريقة الاستدعاء من اى زر امر لهواة الاختصار فى الاكواد من اى نموذج تكون كالتالى ' تعريف متغير لتخزين نتيجة اختيار المستخدم من النافذة المنبثقة Dim Result As Integer Result = MsgBx(Array("سيتم حذف جميع البيانات", "هل أنت متأكد من المتابعة؟"), "تحذير", "نعم,لا", Array("اضغط هنا للموافقة", "اضغط هنا للإلغاء"), "Full-Path\error.png") If Result = 0 Then MsgBox "تم اختيار موافق" ElseIf Result = 1 Then MsgBox "تم اختيار إلغاء" End If ولكن الطريقة الأمثل لسهولة التعديل والاضافة والصيانة فى المستقبل يكون الاستدعاء بالشكل التالى ' تعريف المتغيرات المستخدمة Dim MessageLines As Variant ' تخزين سطور الرسالة (نص رئيسي وفرعي) Dim TitleText As String ' عنوان النافذة المنبثقة Dim ButtonsText As String ' نص الأزرار (مفصولة بفواصل) Dim Result As Integer ' نتيجة اختيار المستخدم Dim IconPath As String ' مسار ملف أيقونة التحذير Dim Tooltips As Variant ' تلميحات توضيحية عند التمرير على الأزرار ' تعيين مسار ملف الأيقونة التحذيرية (يجب التأكد من صحة المسار) IconPath = "Full-Path\error.png" ' تهيئة محتوى الرسالة: MessageLines = Array("سيتم حذف جميع البيانات", "هل أنت متأكد من المتابعة؟") TitleText = "تحذير" ' عنوان النافذة المنبثقة ButtonsText = "نعم,لا" ' خيارات الأزرار (الزر الأول: نعم، الزر الثاني: لا) ' تعيين التلميحات التوضيحية عند تمرير الماوس على الأزرار: ' تلميح للزر الأول (نعم) ' تلميح للزر الثاني (لا) Tooltips = Array("اضغط هنا للموافقة", "اضغط هنا للإلغاء") ' استدعاء الدالة المخصصة لعرض الرسالة: ' محتوى الرسالة -العنوان - اسماء الأزرار - التلميحات - مسار الأيقونة Result = MsgBx(MessageLines, TitleText, ButtonsText, Tooltips, IconPath) ' معالجة النتيجة المرجعة من الدالة: If Result = -1 Then ' حالة الخطأ (-1 تعني فشل في عرض الرسالة) MsgBox "حدث خطأ أثناء عرض الرسالة." ElseIf Result = 0 Then ' الزر الأول (نعم) تم اختياره MsgBox "تم اختيار نعم" ElseIf Result = 1 Then ' الزر الثاني (لا) تم اختياره MsgBox "تم اختيار لا" End If لتكون النتيجة كما بالشكل التالى من النموج بدلا من صندوق الرسائل التقليدى طبعا يمكن تغيير اسماء الازرار عند الاستدعاء من السطر : ButtonsText = "نعم, لا" ليكون مثلا ButtonsText = "موافق , الغاء" وطبعا تغير السطر : MsgBox "تم اختيار نعم" باضافة الكود الذى تريده عند الضغط على الزر انا فقط كتبت الرسالة فى كود الاستدعاء لتوضيح انه سوف يتم تنفيذ الامر ملحوظة : استخدام : Tooltips وهو التلميح عندما يحوم الماوس فوق الازرار فى النموذج اختيارى ممكن عدم استخدامه كذلك استخدام : IconPath وهو مسار لصورة ايقونة تدل على الرسالة اختيارى ممكن عدم استخدامه ولكن طبعا انا كتبت الكود بحيث يوفر اكبر قدر ممكن من المرونه فى تناول او عدم تناول هذه الخصائص لمن يريد تغيير الايقونات مع كل رسالة او تغيير عدد او اسماء الازرار مع كل رسالة وكذلك التلميحات للازرار المستخدمه ملاحطة هامة جدا جدا جدا : لا تنسي اخفاء كل ازرار الاوامر الخمسة فى النموذج الكود سوف يقوم بإعادة اظهار الازرار حسب الاستدعاء تحياتى الحارة CustomMessageBox.zip

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) 📌 اليوم سأقدم لكم فكرة لإنشاء ساعة رقمية مشابهة لألواح الإعلانات المضيئة ، ولكن بطريقة و نكهة مختلفتين كالعادة ▫▪◽◾◻◼ . صورة للنتيجة .. المرفق مفتوح المصدر دون إطالة BackLight2.accdb

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

شكرا جزيلا أخي الفاضل وبارك الله فيك وزادك الله من علمه

اساتذتي الاعزاء @kkhalifa1960و @ابو عارف شكراً جزيلاً وهو المطلوب بالضبط جزاكم الله كل خير

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

تفضل استاذ @((( folks ))) المرفق بعد التعديل بطلبك حسب ما فهمت . ووافني بالرد . 112إحصائية.rar

استاذ @فؤاد الدلوي تفضل المرفق بعد التعديل . الاقساط السنوية غير المدفوعة-2.rar

سامحك الله أستاذ @ناقل ، لك حرية الاستخدام كما تريد ،، ويسعدني رؤية تعديلاتك التي تفكر فيها .. جل ما نقدمه جميعاً هنا هو لوجه الله تعالى أولاً ، ثم لنستفيد منه جميعاً .

انا عدلته بالكود ده Dim MachineName As String MachineName = Environ("COMPUTERNAME") If MachineName <> "DESKTOP-B76NADI" Then MsgBox "لا يمكنك فتح هذا الملف على هذا الجهاز.", vbCritical ' حفظ الملف قبل الإغلاق ThisWorkbook.Save ' إغلاق الملف ThisWorkbook.Close SaveChanges:=False End If

يعني انت تريد بعد العمليات السابقة حذف السعر المدخل سابقا وتريد نقل السعر الموجود في التوزيع ليحل محل السعر السابق ... انظر الصورة

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

السلام عليكم ورحمة الله وبركاته اخوانى الأفاضل هذا الموضوع أرسله لي أحد الإخوة (رجب محمد مرسي) وأحببت أن يشارك فيه من أراد ومن له مشكلة مماثلة يسأل أخونا قائلا =================================================== انا جديد في التعامل مع اكسل فلا اسطيع التعامل بشكل مناسب مع اكواد ومعادلات اكسل .. ولله الحمد انا اعرف عمل كود طباعة شهادة ةاحدة وذلك من خلال record macro هل يمكن طباعة جميع الشهادات عن طريق record macro ام لابد من كتابة الماكرو وهذ ما لا اعرفة لانة يحتاج الى vba الرجاء شرح خطوة خطوة في كيفية عمل ذلك عن طريق record macro او اي شئ يكون مفيد بعيدا عن الاكواد ووجع الاكواد ======================================================== وردا عليه أقول نحتاج أخي في هذه الحالة إلي كود بسيط من 5 أسطر فقط وستجد بالمرفق ماتريد مع شيت بآخر الملف به شرح الكود تفضل المرفق شيت كنترول2.zip

مرفق مقترح المقارنة كميات وأصناف بكل مخزن وبها ملاحظات الاصناف الراكدة لكل مخزن(6).xlsm

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Sub SaveAsPDF11() Dim WS As Worksheet, CrWS As Worksheet Set WS = ActiveSheet: Set CrWS = Sheets("مشروع 1") Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False WS.Range("B2:I47").FormatConditions.Delete WS.Range("A1:Z999").AutoFilter Field:=1, Criteria1:="<>" savePath = "d:\" & WS.Range("AA1").Value & " " & Format(Now, "yyyy-mm-dd,hh.mm") & ".pdf" WS.Range("A1:Z999").ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePath CrWS.Range("B2:I47").Copy WS.Range("B2").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True End Sub

وعليكم السلام ورحمة الله تعالى وبركاته lr = Cells(Rows.Count, 2).End(3).Row تحديد رقم الصف الأخير في العمود B الذي يحتوي على بيانات End(3) هي اختصار للخاصية xlUp التي تعني التحرك صعودا في العمود حتى تصل إلى أول خلية تحتوي على بيانات x = الصف الذي يبدأ منه النطاق المحدد Set my_rg = Range("A" & x & ":A" & lr).SpecialCells(4) لتحديد الخلايا داخل نطاق معين و هو اختصار للخاصية xlCellTypeBlanks التي تعني الخلايا الفارغة إدن بعد تحديد صف بداية النطاق وليكن مثلا الصف 5 الكود Option Explicit Sub test() Dim lr As Long, x As Long, my_rg As Range On Error Resume Next lr = Cells(Rows.Count, 2).End(3).Row x = 5 Set my_rg = Range("A" & x & ":A" & lr).SpecialCells(4) If Not my_rg Is Nothing Then my_rg.EntireRow.Delete End If On Error GoTo 0 End Sub لنفترض ان اخر خلية في العمود B هي 100 إذا كان هناك خلايا فارغة في العمود A ضمن النطاق A5:A100 سيتم حذف الصفوف التي تحتوي على هذه الخلايا مع تجاهل الخلايا التي تتضمن قيم أو معادلات

جرب التعديل التالي توجد ورقة مخفية يتم نسخ البياتان اليها ومنها يتم تحويل الى PDF ترحيل بدون تنسيق شرطي.xlsb

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

Private Sub Workbook_Open() Dim MachineName As String MachineName = Environ("COMPUTERNAME") If MachineName <> "اسم_الجهاز_المسموح" Then MsgBox "لا يمكنك فتح هذا الملف على هذا الجهاز.", vbCritical ThisWorkbook.Close End If End Sub

أخي @أبو أحمد الطلبات الجديدة متفقين ومافي مشكلة وأما القديمة . أنا برمجتهم حسب ماكانوا موجودين الجزء 1 حسب الكلمة أو الرقم أما الجزء 2 يبحث بجميع الحقول . اختار مايناسبك منهم .

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

كبير يا عبداللطيف كبير ، وعلى راسي 🙂 سهله ، وخليني اعلمك كيف تصيد الخطأ 🙂 . Private Sub Form_Error(DataErr As Integer, Response As Integer) 'MsgBox DataErr If DataErr = 3022 Then Response = acDataErrContinue MsgBox "هذا الاسم موجود سابقا" End If End Sub 1602.Data_Exists.accdb

تفضل أخي بطريقتين . 1- من مجلد الصور. 2- من الاسكانر . ووافني بالرد . واذا كان هذا طلبك لا تنسى الضغط عل أفضل اجابة . scanner.rar

المثال : المخزن.accdb