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

السلام عليكم ورحمة الله فى هذا الجزء من المعادلة *(التحميل!$G$2:$G$1496=A10)* استبدل حرف G بحرف C لاتنسى الضغط على CTRL+ SHIFT+ENTER حت تعمل معك المعادلة بشكل جيد

كود اختيار تعليقات من جدول معد مسبقا كود تعليقات من قائمة.rar

السلام عليكم اخواني واحبائى فى الله . اليوم اتيت لكم بمشروع جديد وحصري وهو التحكم فى العالم الحقيقي باستخدام الاكسس ، كالتحكم فى ( فتح البوبات - تشغيل الاناره - تسجيل قرائات حساسات - العد من العالم الحقيقى وتسجيل البيانات - الخ.....) وهذا فيديو للتحفيز : وللبداية والانطلاق فى هذا المشروع يجب من ان تتوفر لديكم بعض من العتاد الاساسية كـ : 1- برنامج اكسس اصدار 2010 او اعلى . 2- كارت اردوينو وهى كارت مفتوحة المصدر و سهلة البرمجة والاستخدام وسوف اقوم بشرحها بالتفصيل على حلقات والتأكد من تنصيب برنامج البرمجة الخاص بها ممكن تحميله من هنا . ويفضل قراءه هذا المقال الذي يعطي نبذة جيده لهذا الكارت للبدء فى استخدامها يمكنك قراءته من هنا . 3- موديل ريلاى واحد خط او اكثر على حسب الرغبة فى عدد الخطوط المرغوب فى التحكم بها او البوابات . وبرجاء قراءه هذا المقال الذي سوف يوضح ما هذا المفتاح وطريقة استخدامه من هنا . 4- اسلاك توصيل بين الموديل و الاردوينو وهى اسلاك جاهزة كما هو موضح . <-----------------------------------------------------------------------------------------------------------------------------------------> كيف سيتم الاتصال : من اسهل طرق التوصيل واكثرها فاعلية وسرعة واتصال فى الجهاتين اى ( ارسال بيانات - واستقبال بيانات ) هو المنفذ التسلسلي Serial Port او RS232 ولمعلومات عنه بالتفصيل بامكانك قراءه هذا المقال من هنا . برجاء قراءه المقالات الموضحه بعاليه قبل البدء فى اى شئ وللحديث بقيه .

السلام عليكم ورحمة الله وبركاته . كما وعدتكم الاصدارالثاني لبرنامج صانع القوائم فى البداية هذا العمل مجاني لوجة الله ولكن اتمنى مزيد من التفاعل لارتقاء العمل وحس المساعدة بيننا فالصدار الاول تخطي 550 مشاهدة و 7 ردود فقط فأذا تخطي هذا المشروع 100 رد يكون المشروع الثاني مفاجأه وهو ارسال رسائل SMS مجاناً معتمداً على الباقة المتوفرة من شركة جوالك دون تكلفة اضافية او وسيط والان فيديو شرح البرنامج : لتحميل البرنامج : https://www.mediafire.com/file/z17cd3rpjtikyxi/ARM.exe مساعدة من الخبراء ان أمكن هل من الممكن تشغيل سكريبتك بالاكسس دون الحجة لتفعيله يدوياً كما موضح بأخر الفيديو مع العلم باننى قمت بمحاولات لا تحصي ولكن لا يعمل بالجودة المطلوبة . ثانياً تشغيل زر تصدير الدوال حتى يقوم الصانع بتصدير الدوال والجدول المخصص للشريط دون الحاجة لاستردادهم يدوياً . ولكم جزيل الشكر .

السلام عليكم ورحمه الله وبركاته أقدم لكم هذا البرنامج وأرجو ان يحوذ أعجابكم ويساعد العاملين فى تكاليف المطاعم ..تحياتى للاستاذ هانى بدر ومن ساعدنى عليه اسم المستخدم /admin الباسورد / 27102003 Raspi Food Cost 1.xlsm

تفضل ..... moh.rar وهذا الفلدر به القاعدة المنشأ فيها الجداول .... ضع الفولدر في الدرايف D New folder (2).rar

تفضل اخى الكريم الملف بعد وضع الكود به كشوفات الطلبة للعام 2021-2022.xlsm

السلام عليكم 🙂 شفت بعض الاوقات لما تحس ان مخك ما يشتغل ، هذا انا الحين 😁 بما انك حددت وين المشكلة في برنامجك ، فانا عملت لك هذه المساعدة : وحدة نمطية اسمها mod_Global_Variables ، وفيها نحتفظ بنوع المستخدم في الحقل ppos ، ويمكن للبرنامج قراءته من اي مكان في البرنامج ، وعلى اساس قيمة ppos ، فقد وضعتها في حدث "الحالي" للنموذج ، فالرجاء وضعها بالطريقة الصحيحة (قلت لك مخي ما يشتغل 🙂) . جعفر 1417.moh.accdb.zip

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

thank you very mach i am sorry because i wasted your time thank you brother

Look my bro. You have wasted my time, I have told you that you have to comment out two specific lines and you didn't do that. Then I have modified the code for you and expected from you to copy the new code but it seems you didn't do that Please back to the code and copy it again to your file and test the code for last time.

The code is working fine for me, please review the modified code in my main post If there are more problems, please attach your file with real data.

Delete the lines I referred to in the code

السلام عليكم ورحمة الله استخدم هذا الكود Sub Transfer() Dim ws As Worksheet, Sh As Worksheet Dim Arr As Variant Set ws = Sheets("vi") Set Sh = Sheets("DATA") Arr = Array(ws.Range("B3"), ws.Range("C7"), ws.Range("A6")) Sh.Range("B4").Resize(, 3) = Arr End Sub

شكرا بارك الله فيكم و انا اسف على ازعجاكم ... اللَّهُمَّ إِنِّي أَسْأَلُكَ بِأَنِّي أَشْهَدُ أَنَّكَ أَنْتَ اللَّهُ لَا إِلَهَ إِلَّا أَنْتَ، الأَحَدُ الصَّمَدُ، الَّذِي لَمْ يَلِدْ، وَلَمْ يُولَدْ، وَلَمْ يَكُنْ لَهُ كُفُوًا أَحَدٌ ان يبارك في اخواننا المنتدي خاصة و الناس عامه .... وشكراً ممكن سوال : الافضل بترتيب 1برمجة الاكسسAVB او 2فيجول استديو او 3فيجول بيسك 4 لغة سي (الله يبارك فيكم تردو عشان تحديد المطلوب تعليمة في الجامعة) و سامحوني الله يبارك فيكم ... وشكرا

شكرا اباجودي على هذه الكلمات الجميلة ، ونسأل الله سبحانه وتعالى ان يقدرنا على المزيد من العطاء 🙂 جعفر

أعتقد أنه لا يوجد حدث في الاكسل يسمى عند ادخال كلمة مرور خاطئة في vbe كما أن حذف الموديولات يتطلب إعدادات خاصة في الماكرو trust access to the vba project object model ولا ينصح باستعمال هذه الخاصية إلا لمن يعرف التعامل معها وليس للعملاء مثلا بالتوفيق

مشاركة مع أساتذتي الكرام فكرتي المتواضعة امكانية التسجيل.accdb

وعليكم السلام ورحمة الله تعالى وبركاته العفو منكم أستاذي الجليل و ومعلمي القدير و والدى الحبيب أستاذ @jjafferr اذا حضر الماء بطل التيمم أستاذي وشتان بين الحلان فكرتي على طريقة الهواة أما طريقتكم هي طريقة المحترفون أستاذي انتم الحلو الذى الذى يزيل مرارة جهلنا والنور الذى ينير ظلمة جهلنا .. انتم سعادة الحياة بالنسبة لنا فسعادة الحياة أن تكون بجانبك وتساندك روح طيبة وكريمة تمنحك وتهديك الفرح والسرور وتدخل على نفوس من حولها الفرح و السعادة ولا أزكيكم على الله وكل اساتذتنا المبجلين كل كلمات ومعان الشكر والعرفان بالجميل لا تكفيكم وتوفيكم قدر حقكم أدامكم الله فوق رؤوسنا وملئ حياتكم سرورا وفرحا وبهجة ورزقكم من حيث لا تحتسبون أدامكم الله روح طيبة تسكن القلوب .. ووجه باسم ترتاح له العيون .. ونفس مطمئنة تمتلك النفوس .. بارك الله لكم في عمركم وفى علمكم و عملكم واهلكم وولدكم وأسال الله تعالى لكم سعادة الدارين وان يزيدكم من فضله كما تدخلون السرور على قلوب طلبة العلم دائما تكثرون من العطاء وبكل سخاء دون كلل ولا ملل ... احسن الله اليكم كما تحسنون الى طلاب العلم دائما اسأل الله لكم السعادة في الدارين والرزق و البركة في العمر والعلم والعمل والاهل والولد واسأله أن يغفر لكم ولوالديكم ومن تحبون وكل المسلمين ان شاء الله شكر الله لكم وجزاكم كل الخير ان شاء الله وأسأله عز وجل أن يعطيكم من عطــاياه ويمنحكم عفوه ورضاه ويغفر لكم من عمركم ما مضى ويقدر لكم الخير فيما أتى .. وأن يجعل السعادة رفيقتكم في الدنيا والآخرة.. اللهم آمين

وممكن على طريقة الاستاذ جعفر فى النموذج مباشرة بهذا الكود Me.cmb_3Dates.RowSourceType = "Value List" Me.cmb_3Dates.RowSource = Empty Dim Days As Integer For Days = 0 To 2 Me.cmb_3Dates.AddItem Format(DateAdd("d", Days, Date_Start), "dd/mm/yyyy") Next Days وان اردنا استعمالها من خلال روتين عام ممكن Function DayLoop2(ByVal DateStart As Date) As String Dim strSQL As String Dim i As Integer Dim N As Integer N = 2 strSQL = "" For i = 0 To 2 strSQL = strSQL & Format(DateAdd("d", i, DateStart), "dd/mm/yyyy") & "; " Next i DayLoop2 = strSQL End Function

السلام عليكم 🙂 الله ان شاء الله يسهل عليك ، وقوم بالسلامة ان شاء الله 🙂 من الصعب التغلب على سرعة اباجودي 🙂 هذه محاولتي: الاستعلام: الحقل ALL ينادي الوحدة النمطية Count_Chr ، ويرسل معها قيمة الحقل Enter ، . الحقل ALL يستلم عدد مرات وجود الحقول الاخرى ، وبين كل قيمة حقل ، وضعت حرف ابجدي متسلسل ، حتى استطيع من خلال الاستعلام ان: انادي الوحدة النمطية مرة واحدة فقط لكل سجل ، ثم نفكك قيمة الحقل ALL الى بقية الحقول (وعلشان تجربة التفكيك ، قمت بعمل وحدة نمطية اسمها myTest ، وكل حقل اعطيته رقم a1 ثم a2 ... وهكذا) . الآن وعندك هذه القيم في استعلام ، وفي وحدة نمطية ، يمكنك الاستفادة منه بالطريقة التي تريدها 🙂 هذه هي الوحدات النمطية: Public Function Count_chr(str As String) As String 'NA = رقم عربي 'CA1 = حرف عربي 'NE = رقم انجليزي 'CE1 = حروف انجليزي كبيرة 'CE2 = حروف انجليزي صغيرة 'B1 = اشكال و رموز Dim i As Integer Dim NA As Integer, CA1 As Integer, NE As Integer, CE1 As Integer, CE2 As Integer, B1 As Integer Dim Each_Letter As String For i = 1 To Len(str) Each_Letter = Mid(str, i, 1) If Asc(Each_Letter) >= 48 And Asc(Each_Letter) <= 57 Then 'English Numbers NE = NE + 1 ElseIf Asc(Each_Letter) >= 65 And Asc(Each_Letter) <= 90 Then 'English, Capital letters CE1 = CE1 + 1 ElseIf Asc(Each_Letter) >= 97 And Asc(Each_Letter) <= 122 Then 'English, Samall letters CE2 = CE2 + 1 ElseIf (AscW(Each_Letter) >= 1569 And AscW(Each_Letter) <= 1594) Or _ (AscW(Each_Letter) >= 1600 And AscW(Each_Letter) <= 1610) Then 'Arabic Letters CA1 = CA1 + 1 ElseIf AscW(Each_Letter) >= 1632 And AscW(Each_Letter) <= 1641 Then 'Arabic Numbers NA = NA + 1 Else 'Symbols B1 = B1 + 1 End If Next i 'send the result, seperated with letters, 'then parse the result into its 6 components (see Function myTest) Count_chr = NA & "A" & CA1 & "B" & NE & "C" & CE1 & "D" & CE2 & "E" & B1 & "F" 'Debug.Print NA & vbTab & CA1 & vbTab & NE & vbTab & CE1 & vbTab & CE2 & vbTab & B1 & vbTab & str End Function Function myTest() Dim a1 As String, a2 As String, a3 As String, a4 As String, a5 As String, a6 As String, ALL As String ALL = "1A22B333C4444D55555E666666F" a1 = Mid(ALL, 1, InStr(ALL, "A") - 1) a2 = Mid(ALL, InStr(ALL, "A") + 1, InStr(ALL, "B") - (InStr(ALL, "A") + 1)) a3 = Mid(ALL, InStr(ALL, "B") + 1, InStr(ALL, "C") - (InStr(ALL, "B") + 1)) a4 = Mid(ALL, InStr(ALL, "C") + 1, InStr(ALL, "D") - (InStr(ALL, "C") + 1)) a5 = Mid(ALL, InStr(ALL, "D") + 1, InStr(ALL, "E") - (InStr(ALL, "D") + 1)) a6 = Mid(ALL, InStr(ALL, "E") + 1, InStr(ALL, "F") - (InStr(ALL, "E") + 1)) End Function . للحصول على الارقام الصحيحة للامر Asc (للارقام والحروف الانجليزية) و AscW (للارقام والحروف العربية) ، استعنت بالصور الموجودة في هذا الموضوع: https://www.officena.net/ib/topic/104923-قراءة-وتفكيك-بيانات-الحقل-الى-حقول/ ولكني لم افهم قصدك في آخر سجلين: المطوب لايتكرر و يسمح له بتكرر مرة واحدة جعفر 1408.Parse_a_Value.accdb.zip

أولا : طهور إن شاء الله، أوصيكم بالصبر والثبات والإكثار من ذكر الله، أعظم الله أجركم، وضاعف مثوبتكم، شفاكم الله وعافاكم اللهم إني أسألك بأسمائك الحسنى وبصفاتك العلا وبرحمتك التي وسعت كلّ شيء، أن تمنّ علي أخونا عبد الله وعلى كل مريض بالشفاء العاجل، وألّا تدع فينا جرحًا إلّا داويته، ولا ألمًا إلا سكنته، ولا مرضًا إلا شفيته، وألبسنا ثوب الصحة والعافية عاجلًا غير آجل، وشافِنا وعافِنا واعف عنا، واشملنا بعطفك ومغفرتك، وتولّنا برحمتك يا أرحم الراحمين إلهي أذهب البأس ربّ النّاس، اشف وأنت الشّافي، لا شفاء إلا شفاؤك، شفاءً لا يغادر سقمًا، أذهب البأس ربّ النّاس، بيدك الشّفاء، لا كاشف له إلّا أنت يا رب العالمين ربنا الله الذي في السماء، تقدّس اسمك، أمرك في السماء والأرض، كما رحمتك في السماء، اجعل رحمتك في الأرض، اغفر لنا خطايانا، أنت رب الطيبين، أنزل رحمة من رحمتك، وشفاءً من شفائك على على كل مريض من أي وجع فيبرأ اللهم يا مُفرّج الكرب يا مُجيب دعوة المُضطرين، اللهم ألبس كل مريض ثوب الصحة والعافية عاجلًا غير آجل يا أرحم الراحمين، اللهم اشفى كل مريض ، اللهم اشفى كل مريض، اللهم اشفى كل مريض، اللهم آمين ----------------------- ثانيا : تتمحور فكرتي المتواضعة في هذه الاكواد والتي تكتب في موديول ويتم استدعائها حسب الحاجة انظر التطبيق داخل الاستعلام Public Function CountCapitals(fld) As Integer If fld & "" = "" Then Exit Function Dim StrLn As Integer CountCapitals = 0 For StrLn = 1 To Len(fld) Select Case Asc(Mid(fld, StrLn, 1)) Case 65 To 90: CountCapitals = CountCapitals + 1 End Select Next StrLn End Function Public Function CountSmall(fld) As Integer If fld & "" = "" Then Exit Function Dim StrLn As Integer CountSmall = 0 For StrLn = 1 To Len(fld) Select Case Asc(Mid(fld, StrLn, 1)) Case 97 To 122: CountSmall = CountSmall + 1 End Select Next StrLn End Function Public Function CountingNumbers(fld) As Integer If fld & "" = "" Then Exit Function Dim StrLn As Integer CountingNumbers = 0 For StrLn = 1 To Len(fld) Select Case Asc(Mid(fld, StrLn, 1)) Case 48 To 57: CountingNumbers = CountingNumbers + 1 End Select Next StrLn End Function Public Function CountingArabic(fld) As Integer If fld & "" = "" Then Exit Function Dim StrLn As Integer CountingArabic = 0 For StrLn = 1 To Len(fld) Select Case Asc(Mid(fld, StrLn, 1)) Case 192 To 214: CountingArabic = CountingArabic + 1 Case 216 To 219: CountingArabic = CountingArabic + 1 Case 221 To 223: CountingArabic = CountingArabic + 1 Case 225: CountingArabic = CountingArabic + 1 Case 227 To 230: CountingArabic = CountingArabic + 1 Case 236 To 237: CountingArabic = CountingArabic + 1 End Select Next StrLn End Function Public Function CountingSpecialCharacter(fld) As Integer If fld & "" = "" Then Exit Function Dim StrLn As Integer CountingSpecialCharacter = 0 For StrLn = 1 To Len(fld) Select Case Asc(Mid(fld, StrLn, 1)) Case 33 To 47: CountingSpecialCharacter = CountingSpecialCharacter + 1 Case 58 To 64: CountingSpecialCharacter = CountingSpecialCharacter + 1 Case 91 To 96: CountingSpecialCharacter = CountingSpecialCharacter + 1 Case 123 To 126: CountingSpecialCharacter = CountingSpecialCharacter + 1 End Select Next StrLn End Function Database5.accdb

السلام عليكم اخواني الاعزاء الكود يفي بالغرض ومعه الرسالة الجديدة تفضل Database4.accdb

وعليكم السلام ورحمة الله وبركاته جرب هذه المحاولة تقارير.xlsm

وعليكم السلام 🙂 رجاء النظر الى جدول ascii هذا ، والذي فيه جميع رموز لوحة المفاتيح الانجليزية: . بمعنى آخر ، كل زر تنقر عليه على لوحة المفاتيح (حرف يمكنك رؤيته وقراءته) ، يتم ترجمتها في الكمبيوتر ، حسب طلب البرنامج الذي تستعمله ، الى واحدة من هذه الارقام والرموز 🙂 من الجدول ، انظر الى الحقل Dec الرقم 10 و 13 ، والقيم التي تقابلها من الحقل Chr (او Char) (ومعناها) ، فهذه القيم هي التي تقرر الانتقال الى السطر التالي ، هكذا chr(10) و chr(13) 🙂 هذه القيم تعتمد على البرنامج الذي يستخدمها ، فهناك من يستعمل 10 وهناك من يستخدم 13 وهناك من يستخدمهم معا 🙂 رجاء تنظر الى المشاركات في هذا الرابط حتى يصير عندك إلمام كامل بالموضوع: . وفي محرر الاكواد VBE ، يمكننا استعمال مسميات هذه الرموز بلغة الاكسس (والتي تم اخذها من لغة Visual Basic ، VB) ، بدلا من الارقام اعلاه ، في محرر الاكواد ، ابحث عن vb constants ، وسترى قائمة المسميات . وعند النقر على الرابط الذي عليه السهم (الاوامر التي تخص موضوعنا) . نرى ان خياراتنا لجواب سؤالك اصبحت: الطريقة 2 او الطريقة 1 Me.text3=Me.text1 & vbNewLine & Me.text2 Me.text3=Me.text1 & chr(13) & chr(10) & Me.text2 Me.text3=Me.text1 & vbCrLF & Me.text2 Me.text3=Me.text1 & chr(13) & chr(10) & Me.text2 Me.text3=Me.text1 & vbLF & Me.text2 Me.text3=Me.text1 & chr(10) & Me.text2 Me.text3=Me.text1 & vbCr & Me.text2 Me.text3=Me.text1 & chr(13) & Me.text2 جعفر

تفضل هذا التعديل Database1.accdb

السلام عليكم كنت ابحث عن طريقة جيده للحماية وبالاستفسار هنا وطرح الاسئلة استفدت من معلومة من الاخوان في المنتدى بارك الله بهم , فكرة ان افضل طرق الحماية الحالية هيا وضع باسورد على قاعدة البيانات بمتداد accdb حيث سيكون من الصعب كسر حماية هذا النوع بسهولة ,, (لايوجد حماية مطلقه) لكن نتكلم عن حماية صعبة وليست سهله , فا الفكرة هوا عمل تطبيق صغير بللغة الفيجول بيسك استوديو الغرض منه فقط تشغيل الاكسيس الذي تم تعريف مساره وتم وضع كلمة السر بداخله حيث سيكون دور تطبيق الفيجول هوا تمرير كلمة السر وحمايتها, المرفق هوا ملف فيجول بيسك مفتوح المصدر حيث يمكن تعديل المسار وكلمة السر , فديو توضيح لعملية تشغيل الملف بعد التنصيب وتشغيل الاكسيس ,, الاكسيس المستخدم هوا الاحد الاخوان بالمنتدى لا اتذكر اسمه قمت بتجربته من باب السرعه 😅 يتطلب لامر وجود فيجول بيسك استوديو 2013 او اعلى اضافة مكتبة اكسيس عمل تحزيم للبرنامج بعد عمل البرنامج والانتهاء من التجربه يمكن حذف البرنامج عن طريق الذهاب الى Control Panel ثم تبحث عن موقع حذف البرامج واسمه Programs and Features هناك ابحث عن اسم البرنامج OpenAccessApplicationWithPassword قم بحذفه اذا احتجت ان تغير المسار او تعدل بالبرنامج , اضافة مكتبة : في يمين برنامج فيجول استوديو نضغط يمين على اسم المشروع OpenAccessApplicationWithPassword ونخار كما موضوح بالصورة بعدها نبحث في خيار Com عن الاكسيس كما موضح بالصورة ونختار المكتبة نأتي للتحزيم وهوا يتكون من خطوات بسيطة , الاول نضغط كلك ايمن على اسم المشروعOpenAccessApplicationWithPassword الموجود يمين برنامج فيجول استوديو ونختار properties بعدها كما موضوع في الصورة اولا نختار مكان حفظ ملفات التنصيب بعد التحزيم, ثم نختار الخيار الموضوح بالصورة ايضا الذي يجب اختياره قبل بدء عملية التحزيم ليتم الغاء جميع علامات الصح المؤشرة في المكتبات ثم نختار من الاسفل الخيار الذي بالوسط prerequisites دورة هوا تحميل جميع ملفات البرنامج الموجودة ثم نضغط OK ليعيدنا الى الصفحة الاولى - تابع اخر صورة بالاسفل أخيراً سنضغط على publish now بهذه الطريقة سيتم تحزيم البرنامج ويمكنكم التجربة بعدها حيث عند تشغيل ملف setup.exe سيتم تثبيت البرنامج وتشغيله مباشرة . ملاحظة ستحتاج الى مكتبة microsoft net framework 4.5 للتشغيل أخيرا الكود الموجود هو لاخ في منتدى اخر لا اتذكر الاسم بالضبط لكن ارجو الدعاء له بظهر الغيب ,, دوري كان تعديل الكود الذي قام بكتابته والغاء فقرة ادخال المسار والباسورد , والامر تطلب مني عده ايام بحث ويوم تعديل الكود بسبب خبرتي القليله في الفيجول استوديو , اتمنى ان تكون الفكرة ناجحة ولو احد الاخوان له باع في كسر حماية البرنامج التي تخص الفيجول استوديو يعطينى رأيه بطريقة التحزيم ولو هناك تحزيم بنوع تشفير معين يكون اقوى فا اتمنى ان يخبرنا الطريقة ,, بالتوفيق للجميع يارب ,, OpenAccessApplicationWithPassword.zip video.zip

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

Private Sub CommandButton1_Click() Dim ctrl As Control, cnt As Long For Each ctrl In Me.Controls If TypeName(ctrl) = "TextBox" Then If IsNumeric(ctrl.Value) Then cnt = cnt + 1 End If Next ctrl MsgBox "TextBoxes With Numbers = " & cnt End Sub

لقد وقعت في مثل هذه المشكلة، وعلى حد علمي لا يوجد لها حل جذري، لكني أجريت عدة عمليات ساعدتني بشكل كبير من حل هذه المشكلة، وهي: - استبدل كل تاء مربوطة (ة) بـ تاء مربوطة مسافة (ة ) - (ا) بـ (ا ) مع مطابقة شكل مع مطابقة همزة الألف. - (ى) بـ (ى ) - تبحث في الملف عن الكلمات الطويلة عن طريق البحث بأي حرف، مثل: (^$^$^$^$^$^$^$^$^$^$^$^$^$^$^$^$^$^$^$^$^$^$^$) - تلونها باللون الأحمر مثلا، ثم تبحث في الملف عن الكلمات ذات اللون الأحمر، فإذا كان هناك التصاق فصلته . - وتكرر هذه العملية مع إنقاص حرف حتى تصل إلى حرفين، وبهذا يعود الملف إلى الوضع السليم. * هي عملية مرهقة، لكنها أفضل من إعادة كتابة الملف مرة أخرى.

مبروك الأستاذ lionheart إنضمامك لعائلة الخبراء ,أسأل الله لك التوفيق والنجاح دائما ..وأعانك الله على هذه المسئولية الجديدة وسدد الله خطاك عن حق وجدارة بارك الله فيك وزادك الله من فضله

Sub Test() Dim r As Range, c As Range, cel As Range, x As Long Application.ScreenUpdating = False Application.EnableEvents = False Set r = Range("E3:E" & Cells(Rows.Count, "E").End(xlUp).Row) Set c = Range("H5") Set cel = Range("L1") cel.CurrentRegion.ClearContents Do With cel .Offset(1).Resize(r.Rows.Count).Formula = "=SumSolver(" & r.Address & ", " & c.Address & ", " & x + 1 & ", Row(A1))" If .Offset(1).Value = "" Then Exit Do x = x + 1 .Value = x Set cel = cel.Offset(, 1) End With Loop Until x = 100 Application.EnableEvents = True Application.ScreenUpdating = True End Sub Function SumSolver(numbers, t As Double, Optional pt As Long = 1, Optional s As Long = 1) Dim i&, ii!, p&, n(), w, r# If pt < 1 Or s < 1 Then SumSolver = CVErr(xlErrNum): Exit Function w = Split(Application.Trim(Replace(Replace("|" & Join(Application.Transpose(numbers), "||") & "|", "|0|", "|"), "|", " ")), " ") ReDim n(1 To UBound(w) + 1) For ii = 1 To 2 ^ (UBound(w) + 1) - 1 For i = 1 To UBound(w) + 1 n(i) = (Int(ii / 2 ^ (i - 1)) Mod 2) * w(i - 1) r = r + n(i) Next i If Val(r) = Val(t) Then p = p + 1: If pt = p Then Exit For r = 0 Next ii w = Split(Application.Trim(Replace(Replace("|" & Join(n, "||") & "|", "|0|", "|"), "|", " ")), " ") If pt > p Or s > UBound(w) + 1 Then SumSolver = "" Else SumSolver = Val(w(s - 1)) End Function The UDF SumSolver taken from this link http://excel-egy.com/forum/t2787

قرار صائب من إدارة حكيمة @lionheartمنذ مشاركاته الأولى وأنا أشعر أنه أحد عمالقة هذا الصرح مليون مليار مبارك وأقترح عليه استعمال osk الموجودة في جميع إصدارات الويندوز أو touch keyboard الموجودة في ويندوز 10 فهما يدعمان اللغة العربية حتى وإن كانت لوحة المفاتيح hardware لا تدعمها خالص دعواتي بالتوفيق للجميع

Thank you very much for this trust. I am not expert, I am just a learner

No way without using VBA

فى البداية نقوم بفتح برنامج الاردوينو ومسح المحتوي الذى بداخلة كله ولصق هذا الكود : // Example_1_Computer MSACCESS_Interfacing // Design By : Karim Adel El-Hosseny // Mobile : 01277877151 int Door=7; // تهيئه متغير يقوم يتعويض رقم المنفذ 7 الى اسم لسهولة البرمجة int value; // تهيئة متغير لتخزين قيمة القراءه من المنفذ التسلسلي void setup () // دالة عامه لتهيئة المنفذ التسلسلي { Serial.begin(9600); // ضبط معدل النقل ويجب ان تتوافق هذه القيمة مع القيمة المضبوطبه بالبرنامج بالاكسس pinMode(Door,OUTPUT); // تهيئة الطرف الخاص بالخرج digitalWrite(Door,LOW); // جعل قيمة الجهد المسلط على الطرف الخاص بالخرج مساوى لصفر فولت } void loop () { // دالة تكرار لا نهائية value = Serial.read(); // تخزين قيمة البيانات المستلمة من المنفذ التسلسلي والمرسلة من الاكسس بالمتغير المحجوز مسبقاً if (value == '1') // يقوم هذا الامر من مراجعة قيمة البيانات المرسلة اذا كانت مساوية للواحد ويتحقق الشرط يقوم بتنفيذ الاوامر التالية { digitalWrite(Door,HIGH); // جعل الالجهد المسلط على الطرف مساوية لاعلى فولت ممكن delay(3000); // الانتظار لمده ثلاث ثواني digitalWrite(Door,LOW); // جعل الجهد المسلط على الطرف مساوية لاقل فولت ممكن } else if (value == '0') {digitalWrite(Door,LOW);} // وفى حالة عدم تحقق الشرط يجعل الجهد المسلط على الطرف لاقل فولت ممكن } ولفهم الكود بشكل اكبر سنقو بشرحة خطوه خطوه فى البداية تعريف للكود والمصمم له : // Example_1_Computer MSACCESS_Interfacing // Design By : Karim Adel El-Hosseny // Mobile : 01277877151 -------------------------------------------------------------------------------------------------------------------------------- int Door=7; int value; وفى هذا الجزء قمنا بحجز سجل ( متغير رقمي ) فى الذاكره المؤقته بالميكروكونترول باسم Door و جعلنا قيمتها 7 و 7 هى رقم الطرف الذى سيوصل عليه البوابة او لمبة الاناره ويكون الرقم مكتوب بجوار الطرف كما بالصورة : وحجز خانة اخري بالمسمي Value لتسجيل بها البيانات المستقبله من طريق السيريال بورد . void setup (){ } وهى دالة محجوزة بالميكروكونترول ويكتب بها اوامر النهيئة الخاصة بالاطراف او الموديلات الداخلية المدمجة معه . Serial.begin(9600); ويقوم هذا الامر بتفعيل وتهئية موديل السيريال بورد المدمج مع الميكروكونترول ويخبره بان معدل نقل البيانات المستخدم هو 9600 كيلو بايت ويجب ان يكون جهاز الكمبيوتر متوافق مع هذا الرقم وايضا البيانات المرسلة من الاكسس كما سنوضحها لاحقاً . pinMode(Door,OUTPUT); طبيعة الطرف ان الاردوينو لكل طرف بها وظيفتين اساسيتان والبعض اكثر من وظيفة فالوظيفه الاولى هى استعمالة كخرج بمعني ان يقوم بتوصيل كهرباء لهذا الطرف او قطع الكهرباء عنه وهذا مفهوم بسيط لتسهيل استيعابه والوظيفة الشانية ان يستخدم كدخل اى ان يقوم بفحصه هل يوجد عليه كهرباء ام لا . اذا فالوظيفة الاولى كخرج والثانية كدخل . ونحن هنا نستخدمة كخرج فنامره عند ارسال قيمة معينه من الاكسس يقوم بالتوصيل واذا انقطعت يتوقف . digitalWrite(Door,LOW); وكما وضحنا فى الامر السابق اننا نستخدمه كخرج فيتحكم هذا الامر فى طبيعة الخرج وقمنا بامره ان يجعل الكهرباء المسطله اقل قيمة كهربيه اى صفر فولت لا لا يقوم بالتوصيل او التشغيل . void loop () { } وهى دالة البرنامج الرئيسى التى اول ما يعمل الميكرو ويقوم بالتهيئة يدخل اليها لتنفيذ التعليمات المرغوبة . ملحوظة هامه : ان الميكروكونترول ليس مرن كالاكسس بمعنى انه يقوم بتنفيذ التعليمات بالترتيب ولا يستطيع ان يقفز الى امر اخر دون المرور على البقية . value = Serial.read(); وهنا نامر الميكرو بتسجيل البيانات المستقبلة فى المتغير المحجوز سلفاً فى الكود . if (value == '1') { وكالمعتاد والمتوقع عن ايجاد دالة الشرط IF كما تعودنا استخدامها فى الاكسس وتختلف فقط بطريقة كتابها كما موضح . وتقوم بفحص حالة المتغير فاذا كانت قميته تساوى واحد صحيح يقوم بتنفيذ الاوامر واذا لم تكن يقوم بتنفيذ التالى وكذلك يمكن استخدام Elseif ونرسل قيمة مثلا 2 فيقوم بفتح بوابة اخري وهكذا . digitalWrite(Door,HIGH); فاذا تحقق الشرط يقوم بجعل قيمة الخرج المسلط على الطرف المحدد سلفاً باعلى قيمة فولت لتشغيل الريلاى لفتح البوابة . delay(3000); وهذه داله تمنيت وجودها فى الاكسس وهى دالة تأخير زمني والرقم 3000 بمعني 3 ثواني فالميكروكونترول لديه قدره لتقسيم الثانية الواحده الى 1000 جزء ويتعامل معها كجزء من الـ1000 digitalWrite(Door,LOW); بعد الانتظار لمدة ثلالث ثواني يقوم بتخفيض الفولت الى صفر لغلق البوابة واذا احببتم زياده الوقت نقوم بزياده ال 3000 else if (value == '0') {digitalWrite(Door,LOW);} وفى حالة عدم تحقق الشرط او عدم وجود قيمة يقوم بابقاء الفولت منخفض للحفاظ على غلق البوابة . وبعد الانتهاء من ادخل الكود نقوم بالضغط على علامه الصح بالاعلى للتأكد من صحه الكود وفى حالة الخطأ سيقوم البرنامج بالتوضيح فى الجزء الذى بالاسف بالاخطاء الموجوده ويجب ان تظهر هذه العبارات التى توضح المساحة المستخدمة من الذاكره الخاصة بالميكرو والرام فاذا ظهرت هذه الرسالة يكون الكود خالى من الاخطا وبامكانك شحن الاردوينو بالبرنامج من هذه العلامة : وهكذا نكون اتممنا برمجه الاردوينو بنجاح . والله الموفق . ونلتقي قريباً .

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

الأخوة الكرام/ كود تغيير ترتيب اسماء من خلال مربع قائمة الموجود بالمشاركة 86 كود ابداع وخيال ولكن أذا كانت الاصناف أكثر من 4 صفوف لا تظهر في الفورم أيضاً عند تغيير رقم الصف والعمود عن A1 لا تظهر الاصناف كذلك في الفورم . أرجو الرد جزاكم الله خيراً فأنا بحاجة الى هذا الكود.

الاستاذ يحياوي : تحية طيبة مرفق اكواد رياضية رائعة - 2 ملف - مع شرح بسيط لتطبيقات vba مع الاكسل لاستاذنا الكبير محمد طاهر وفقك الله ياسر الحافظ شرح برنامج اكسل و تطبيقات الفيجوال مع اكواد رياضية رائعة.rar

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

اخي الكريم القضية لها علاقة بتسمية النطاق لاحظ الصور و المثال تغيير ترتيب من خلال مربع قائمة.rar