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

تم تعديل المرفقات فى المشاركة الرئيسية التعديلات الجديدة : تفقيط عملات متعددة فى وقت واحدة تفقيط الاعداد فقط بدون بيانات العملات - تم مراعاة تفقيط الاصفار بعد العلامة العشرية مثل (فاصل صفر و صفر و أربعة و عشرون لا غير) للرقم .0024

التحديث 2:- 1- تم برمجة نماذج الاكسيس للتعامل مع قاعدة البيانات (mysql) بدون استخدام Connector/ODBC MYSQL (حيث تم عمل صفحات وتعديل الاكواد للتعامل مع الوسيط الجديد "صفحات php") 2- تم اضافة صفحه لعرض وتعديل وحذف المستخدمين 3- تم تعديل صفحه تعديل البيانات لربطها مع الصفحه عرض البيانات 4- تم اضافة نموذج جديد وجدول جديد لحفظ اعدادات الموقع (الهوست) ..... وبعض الامور يمكنك استكشافها بنفسك (الغرض منها التيسير على تعديلات الاكواد فبدل ما كان كل ما تحب تغير العنوان تذهب لكل كود وتعدله ) ((( سبب هذا التحديث : لاحظت ان اغلب مواقع الاستضافة لا تسمح باستخدام الاتصال عبر ODBC لقواعد البيانات الخاصه بها وهذا للامور الحماية لهذا قمت بعمل تعديلات على الصفحات وازالة بعض الامور التى لا تتماشي مع الوضع الجديد لان ف الاصل ان الموقع ليس محلى انما له دومين معروف وسهل الاتصال به والتعامل معه وقد تم التجربه على دومين فرعي لصديق عندي وجميع الصفحات تعمل بدون اى مشاكل ان شاء الله ))) فى نقطه حابب انوه عليها وهي فى غاية الاهمية طبعا جميع الصفحات موجوده لغرض التعلم واخذ الافكار منها لذا عند محاولة تنفيذ الفكره لابد ان تأخذ فى الاعتبار طرق الحماية وطريقة عمل اكثر فاعليه وهذا قد يتطلب وجود مبرمج المحاولة بنفسك وعمل الصفحات واخذ الاكواد وفهم الالية التى تعمل بها الصفحات وطريقة جلب البيانات من الصفحات الى الاكسيس وغيرها من الامور لا مانع لكن اكرر لابد ان تجعل الصفحات اكثر حماية والتحقق من انه ليس هناك اى ثغره قد يستغلها اصحاب النفوس المريضه 😠 وبها قد يخترق القاعده والتعديل على الصفحات 😨 اذا نويت تطبيق هذا على دومين 🙂 المرفقات هي الصفحات التى تم تعديلها وتم اضافتها وملف الاكسيس بعد التعديل عليه (هناك بعض التحسينات جاري العمل عليها للصفحات لكن محتاج وقت وحين الانتهاء منها سوف ارفع الملفات من جديد بعد الانتهاء من التحسينات) APP.rar LAB.rar

الاكسل يتعامل مع الخلايا المدمجة كأنها خلية واحدة و قد لا يبدو أن هناك فائدة لحساب عدد الخلايا المدمجة بعددها الاصلي قبل الدمج، ولكن من خلال شرحي التالي سأوضح لكم فائدتها و لعلكم تستفيدون أيضا. #وصف المشكلة:- كنت اعمل على ملف إكسل لحساب الكميات الموضح في الصورة و استعنت بدالة COUNT الموضحة في الصورة اعلاه لكتابة وحدة القياس (عدد او م او م² او م³) تلقائيا بناءً على عدد الخلايا التي تحتوي على أرقام في الاعمدة D:G لكل صف على حدة. في بعض الأحيان ربما امتلك قياس جاهز بوحدة المساحة (م²) و عندها سأقوم بدمج خليتين معا او قياس جاهز بوحدة الحجم (م³) و سأدمج 3 خلايا معا، و هنا المشكلة، الاكسل سيتعامل مع هذه الخلايا المدمجة كأنها خلية واحدة و عند دمج خليتي و كتابة قيمة المساحة (التي قيمتها م²) سيظهر الأكسل الوحدة (م) و هذا خطأ و إذا اضفت رقم ثالث (ضرب المساحة * البُعد الثالث) الوحدة هي (م³) للحجم و لكل الاكسل سيظهر الوحدة م² لانه يحسب الخليتان المدمجتان كخلية واحدة. و نفس المشكلة عند دمج ال3 خانات و كنابة قيمة الحجم يظهر الاكسل الوحدة م و ليس م³ #خطوات حل المشكلة بالإستعانة بالذكاء الاصطناعي: طلبت من الذكاء الإصطناعي حل لهذه المشكلة فاقترح لي كود VBA يقوم بتوليد دالة جديدة -الضغط على (alt + f11) لفتح VBA -اختيار insert > module و في هذه النافذة سنكتب أوامر تأليف الدوال، يمكن كتابة كل الدوال في نفس النافذة (نفس الوحدة النمطية module). 1.كود يحسب عدد الخلايا في النطاق بغض النظر عن الدمج: Function CountMergedCells(rng As Range) As Integer Dim cell As Range Dim count As Integer count = 0 For Each cell In rng count = count + cell.MergeArea.Cells.count Next cell CountMergedCells = count End Function و إستدعاء الدالة بكتابة اسمها في شريط الصيغة: CountMergedCells(range) حيث range هو نطاق الدالة مثل A2:A5 و هذه الدالة لم تحل مشكلتي و لا أظنها عملية لأنها تحسب عدد كل الخلايا في النطاق بغض النظر عن إذا تم إضافة رقم او كلمة او كانت فارغة (ربما تكون مفيدة لشخص اخر في تطبيق عملي مختلف) 2. كود تأليف دالة تحسب الخلايا التي بها قيم فقط (سواء رقم او نص او رمز) و تجاهل الخلايا الفارغة: نجحت هذه الدالة التي تم تأليفها و طلبت منه اوامر تقوم بتأليف دوال مشابه للدوال COUNT و COUNTA و COUNTBLANK فكان رده كالتالي: أ. دالة CountNumbersInMergedCells تقابل COUNT: هذه الدالة تحسب عدد الخلايا التي تحتوي على أرقام فقط، مع مراعاة عدد الخلايا المدمجة: Function CountNumbersInMergedCells(rng As Range) As Integer Dim cell As Range Dim count As Integer count = 0 For Each cell In rng If cell.Address = cell.MergeArea.Cells(1, 1).Address Then If IsNumeric(cell.Value) And Not IsEmpty(cell.Value) Then count = count + cell.MergeArea.Cells.count End If End If Next cell CountNumbersInMergedCells = count End Function إسم الدالة لكتابتها في شريط الصيغة: CountNumbersInMergedCells ب. دالة CountAllInMergedCells تقابل COUNTA هذه الدالة ستحسب عدد الخلايا التي تحتوي على أي قيمة (بما في ذلك الأرقام والنصوص وغيرها) و تجاهل الخلايا الفارغة مع مراعاة عدد الخلايا المدمجة: As Integer Dim cell As Range Dim count As Integer count = 0 For Each cell In rng If cell.Address = cell.MergeArea.Cells(1, 1).Address Then If Not IsEmpty(cell.Value) Then count = count + cell.MergeArea.Cells.count End If End If Next cell CountAllInMergedCells = count End Function إسم الدالة لكتابتها في شريط الصيغة: CountAllInMergedCells ج. دالة CountBlankInMergedCells تقابل COUNTBLANK هذه الدالة ستحسب عدد الخلايا الفارغة فقط مع مراعاة عدد الخلايا المدمجة: Function CountBlankInMergedCells(rng As Range) As Integer Dim cell As Range Dim count As Integer count = 0 For Each cell In rng If cell.Address = cell.MergeArea.Cells(1, 1).Address Then If IsEmpty(cell.Value) Then count = count + cell.MergeArea.Cells.count End If End If Next cell CountBlankInMergedCells = count End Function إسم الدالة لكتابتها في شريط الصيغة: CountBlankInMergedCells #تجربة الدوال و التأكد من عملها بصورة صحيحة: هذه الدوال تعمل بصورة ممتازة و تكتب الناتج تلقائيا و بسرعة مثل اي دوال اخرى في اكسل و عند اجراء اي تعديل يتم حساب الناتج الجديد، و لأن الفرق بين هذه الدوال الجديدة و الدوال الموجودة مسبقا في اكسل هو التعامل مع الخلايا المدمجة فلابد من تجربة دمج الخلايا و إلغاء دمجها و التأكد من عملها جيدا، عندما اقوم أولا بدمج الخلايا التي تحتاج لدمج ثم اكتب القيم في الخلايا يظهر الناتج بصورة صحيحة و بدون مشاكل. و لكن المشكلة هي عند كتابة القيم أولا ثم دمج خلية تحتوي على قيمة مع خلية خالية (أو اكثر) مجاورة لها لا يتم حساب الناتج تلقائيا، و أيضا عند كتابة القيمة أولا في خلية مدمجة ثم إلغاء الدمج لا يتم تحديث الناتج تلقائيا. اتوقع ان سبب هذه المشكلة هو أن الإكسل مبرمج على تحديث الناتج بعد كتابة القيم و الضغط على Enter و لم يتم برمجته لتحديث الناتج بعد دمج الخلايا أو إلغاء دمجها لأن كل دوال إكسل لا يتأثر ناتجها بالدمج و إلغاءه. *حلول هذه المشكلة: طلبت من الذكاء الإصطناعي حل هذه المشكلة بتحديث الناتج تلقائيا بعد دمج الخلايا و إلغاء دمجها. على مدار يوم كامل و أنا أعمل على هذه المشكلة مع الذكاء الإصطناعي و إقترح لي المئات من أكواد ماكرو (VBA) و كلها لم تنجح إلا كودان كانا اقرب لحل المشكلة: الكود الأول: كان يقوم بتحديث النتائج تلقائيا بعد الدمج و إلغاءه و لكنه يستمر في العمل بدون توقف و يظهر الخطأ #value! مكان الناتج و يصاب الأكسل بتهنج و يغلق من تلقاء نفسه. الكود الثاني كان يقوم بتحديث الناتج فقط عند دمج الخلايا و عند إلغاء دمجها لا يحدث الناتج. فكانت الحلول الناجحة (لا تعمل تلقائيا بعد الدمج و إلغاء) هي: 1. دمج الخلايا أو إلغاء دمجها اولا ثم إضافة القيم ثانيا. 2. عند حدوث العكس بكنابة القيم اولا ثم احتجنا لدمج الخلايا أو إلغاء دمجها فيجب إعادة كتابة القيمة او كتابة اي قيمة اخرى او حذفها داخل نفس نطاق الدالة. 3. إضافة زر ماكرو يقوم بعملية إعادة الحساب لكامل ورقة الإكسل و كود الماكرو هو: Sub RecalculateMergedCells() Application.CalculateFull End Sub و يجب وضعه في وحدة نمطية (module) جديدة مستقلة عند السابقة التي فيها الدوال التي تم توليدها. و يمكن عمل إختصار من لوحة المفاتيح لهذا الماكرو. و هذا الحل قد يكون مفيد في حالة البيانات الكبيرة التي يصعب مراقبة ناتجها إذا كان صحيحا أم لا. #آراءكم و مقترحاتكم و تجاربكم: انتظركم بأن تبدو لي رأيكم في هذه الدوال التي تم توليدها بإستخدام VBA، واذكروا أمثلة أخرى يمكن الإستفادة فيها من هذه الدوال. وأيضا جربوا هذه الدوال و اذكرو لي ملاحظاتكم و المشاكل التي واجهتموها و هل واجهتكم نفس مشكلتي أم لا؟ و أيضا انتظر منكم مقترحات حول حلول اخرى للمشكلة التي واجهتني. ────── مع تحياتي أحمد فتحي.

ارى ان ادخال 13 او 14 او 15 افضل واسهل للمستخدم لأنه بمجرد ادخال 13 يتحول الوقت امامه آليا الى الواحدة مساء ومع هذا كل شيء جائز في البرمجة انظر المثال طبقت على يومي السبت والأحد انقر نقرا مزدوجا على الحقل تجده يحول الوقت من الصباح الى المساء والعكس صحيح مواعيد الاستشاريون4.rar

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

فيه عندك حاجة اسمها الإرتساء الأفقي والإرتساء الرأسي .. ممكن تتحكم فيه بموقع العنصر ( يمين - يسار - كلاهما ) والإرتساء الرأسي ( للأعلى - للأسفل - كلاهما ) هذا ينطبق على جميع العناصر في النموذج .. جرب تضبطها بنفسك 🙂 النتيجة : ( ويمكنك نقل الأيقونات أيضا إلى اليسار ) 🙂 Modern Main Page With Main Menu ENGLISH.rar

لله درك يا أبو جودي 🙂 إحنا ما لحقنا نفهم الأكود السابقة إلا ونلقاك غيرت التشكيلة الداخلية 😂🖐🏻 نحتاج سنة ثانية علشان نستوعب الصدمة الجديدة .. 👊🏻 فن وروعة وإبداع ما يكفوش لوصف هذي التحفة الفنية الفريدة 😊 بس باقي حتة ملاحظات صغننين وإن شاء الله تكون الأخيرة 😅✋🏻: في عندنا شح في (الواوات) هنا 😁 مثلا هذي في تفقيط الرقم : ألف (و) واحد .. ألفان (و) واحد محتاجة مسافة ==> عمانيبيسة ==> ومحتاجة واو بينهم الفواصل => صفر و صفر (و) واحد. معلش إستحملنا اليومين دول ( دا احنا واقفين لك وحنطلع عينك يا راجل ) أمااااااااااااااااااااااال 😂

شكر وتقدير واحترام من اخيك روعه روعه روعه

اعتقد يقصد الـتسمية " Caption " والحل فى وحدة نمطية عامة Public Function CopyCaptionToTextBox(TextBoxName As String) Dim ctrl As Control Set ctrl = Screen.ActiveControl If TypeOf ctrl Is CommandButton Then Forms(ctrl.Parent.Name).Controls(TextBoxName).Value = ctrl.Caption End If End Function للاستدعاء على اكثر من زر اولا تحديد كل الازرار التى نريد منها تنفيذ هذا الاجراء والاستدعاء يتم بكتابة الكود بالشكل التالى فى الحدث عند الضغط طبعا مع تغيير YouTextBoxNameInForm باسم مربع النص الموجود فى النموذج =CopyCaptionToTextBox("YouTextBoxNameInForm") المرفق بعد التعديل RR.accdb

بسم الله ، ما شاء الله ، الله أكبر ، الله أكبر .. عيني عليك باردة يا معلم سؤال لولبي قد يخطر في ذهن الآخرين ، كيف يمكن استدعاء التفقيط في مربع نص داخل نموذج بعد ما قدرت أوصل للجزئية دي ن كنت محتاج أتعلم لغات هذه محاولتي المتواضعة في تعديل بسيط على هذه الدالة للتعرف على القيم السالبة كما طرحها الأستاذ @Moosak، وطبعاً ده بعد إذن البشمهندس @ابو جودي Function ConvertNumberToWords(number As Variant, Optional language As String = "ar") As String If Nz(number, "") = "" Or Len(number) = 0 Or number = Empty Then ConvertNumberToWords = "" Exit Function ElseIf IsNumeric(number) And number = 0 Then If language = "ar" Then ConvertNumberToWords = Chr(213) & Chr(221) & Chr(209) Else ConvertNumberToWords = "Zero" End If Exit Function ElseIf Not IsNumeric(number) Then If language = "ar" Then ConvertNumberToWords = Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(219) & Chr(237) & Chr(209) & Chr(32) & Chr(213) & Chr(199) & Chr(225) & Chr(205) & Chr(201) ' "قيمة غير صالحة" Else ConvertNumberToWords = "Invalid value" End If Exit Function End If Dim isNegative As Boolean isNegative = (number < 0) If isNegative Then number = Abs(number) End If Dim CurrencyUnits As Variant Dim CurrencySubUnits As Variant Dim PrefixText As String Dim SuffixText As String Dim currencyValues As Variant Dim NumberOfDecimalPlaces As Integer Dim isCurrencyFeminine As Boolean currencyValues = GetCurrencyValues(language) NumberOfDecimalPlaces = IIf(IsNumeric(currencyValues(11)), currencyValues(11), 2) isCurrencyFeminine = currencyValues(12) If language = "ar" Then CurrencyUnits = Array(currencyValues(0), currencyValues(1), currencyValues(2), currencyValues(3), currencyValues(4)) CurrencySubUnits = Array(currencyValues(5), currencyValues(6), currencyValues(7), currencyValues(8), isCurrencyFeminine) PrefixText = Chr(221) & Chr(222) & Chr(216) SuffixText = Chr(225) & Chr(199) & Chr(32) & Chr(219) & Chr(237) & Chr(209) Else CurrencyUnits = Array(currencyValues(0), currencyValues(1), currencyValues(2), currencyValues(3), currencyValues(4)) CurrencySubUnits = Array(currencyValues(5), currencyValues(6), currencyValues(7), currencyValues(8), currencyValues(9), isCurrencyFeminine) PrefixText = "Only" SuffixText = "No more" End If Dim fullNumber As Variant Dim integerPart As String Dim fractionalPart As String Dim integerWords As String Dim fractionalWords As String If IsNumeric(number) And number > 0 Then fullNumber = Split(IIf(InStr(number, ".") > 0, number, number & ".0"), ".") integerPart = IIf(Len(fullNumber(0)) > 21, Right(fullNumber(0), 21), fullNumber(0)) fractionalPart = Mid(fullNumber(1) & String(20, "0"), 1, NumberOfDecimalPlaces) integerWords = ConvertToWords(integerPart, CurrencyUnits, language) fractionalWords = ConvertToWords(fractionalPart, CurrencySubUnits, language) Dim ResultConvert As String ResultConvert = PrefixText & " " & integerWords & IIf(Len(integerWords) > 0 And Len(fractionalWords) > 0, IIf(language = "ar", Chr(32) & Chr(230), " and "), "") & fractionalWords & " " & SuffixText ResultConvert = Trim(Replace(ResultConvert, " ", " ")) If ResultConvert = Chr(221) & Chr(222) & Chr(216) & " " & Chr(225) & Chr(199) & Chr(32) & Chr(219) & Chr(237) & Chr(209) Then ResultConvert = "" If ResultConvert = "Only" & Space(1) & "No more" Then ResultConvert = "" If isNegative And language = "ar" Then ResultConvert = Chr(32) & Chr(211) & Chr(199) & Chr(225) & Chr(200) & " " & ResultConvert ElseIf isNegative And language <> "ar" Then ResultConvert = "Negative " & ResultConvert End If ConvertNumberToWords = ResultConvert Else ConvertNumberToWords = Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(219) & Chr(237) & Chr(209) & Chr(32) & Chr(213) & Chr(199) & Chr(225) & Chr(205) & Chr(201) End If End Function Convert currency numbers to words v 6.accdb

هذا الملف ، بصيغة ثانية ، وللعلم ، هذا الملف من المشاركة الاولى جعفر AlignListbox.MDB.zip