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

بسم الله والصلاة والسلام على رسول الله وعلى آله وصحبه ومن والاه أما بعد: السلام عليكم ورحمة الله وبركاته ...إخوتي الكرام بعد أن اطلعت على دروس أخينا الحبيب ياسر خليل أبو البراء حول الفلترة المتقدمة وكذلك الفيديوهات التي تبين ذلك مشكوراً - جزاه الله خيراً على ما قدم ويقدم ولكم بمثله أيضاً - أردت أن أقدم لكم تصفية متقدمة بين تاريخين وفق عدة معايير ..بالكود حيث بإمكانك تحديد تاريخي البدء والانتهاء ..وأيضاً المعايير للتتغير تلقائياً وفق الكود في حدث الورقة كما يلي: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range(" l4:p4")) Is Nothing Then Call تصفية_متقدمة End If End Sub أما الكود الأساسي للتصفية المتقدمة فهو في حدث موديول وفق الآتي: Sub تصفية_متقدمة() ' مفتاح الاختصار: Ctrl+Shift+S ورقة1.Range("B9").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "متقدمة!Criteria"), CopyToRange:=Range("متقدمة!Extract"), Unique:=False End Sub هذا من ناحية الأكواد ،أما المعادلات ضمن معادلة صفيف Ctrl+Shift+Enter يقوم بالتصفية حسب التاريخ: =IFERROR(INDEX(B$10:B$25;SMALL(IF(($C$3<$B$10:$B25)*($C$4>=$B$10:$B25);ROW($B$10:$B25)-9);ROW(A1)));"") أرجو أن تكون به فائدة ومن كان لديه ما يثري الموضوع فليتحفنا بمشاركته مشكوراً ...لأنني أحب التعلم وإن لم أستطع إدراك الكثير والحمد لله على ما يسّر الله لنا والصلاة والسلام على سيد المرسلين والحمد لله رب العالمين ...والسلام عليكم. حمل الملف من هنا

وعليكم السلام ورحمة الله وبركاته أبي الحبيب أبو يوسف الحمد لله الذي هداك للتعلم وتعلي إخوانك .. بارك الله فيك وجزاك الله كل خير إضافة للموضوع وكودك هو الأفضل والأيسر والأسهل في التطبيق إليك حل بالأكواد لاستخراج البيانات بين تاريخين فقط بدون اية شروط أخرى ولكن باستخدام المصفوفات arrays كنوع من التدرب على استخدام المصفوفات Sub DataBetweenTwoDates() Dim Arr, Temp, I As Long, P As Long, startDate As Date, endDate As Date Arr = Range("B9").CurrentRegion.Offset(1).Value startDate = Range("C3").Value2: endDate = Range("C4").Value2 ReDim Temp(UBound(Arr, 1) - 1, UBound(Arr, 2) - 1) For I = LBound(Arr, 1) To UBound(Arr, 1) If Arr(I, 1) >= startDate And Arr(I, 1) <= endDate Then Temp(P, 0) = Arr(I, 1) Temp(P, 1) = Arr(I, 2) Temp(P, 2) = Arr(I, 3) Temp(P, 3) = Arr(I, 4) P = P + 1 End If Next I Range("L10").Resize(UBound(Temp, 1), UBound(Temp, 2) + 1).Value = Temp End Sub

السلام عليكم ورحمة الله وبركاته اليوم سنذكر طريقة اخرى لعمل آله حاسبة في حال اذا عمل الكود السابق على نظام 32 بت فقط اما اليوم سنذكر طريقة تفي لكل الاغراض الكود كالتالي Public Class Form1 'سنقوم بالاعلان عن ثلاثة متغيرات لتخزين القيمة الاولي والعملية الحسابية والقيمة الثانية 'القيمةالاولى Dim nn1 As Double 'القيمة الثانية Dim nn2 As Double 'العملية الحسابية Dim nn As String Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click TextBox1.Text = TextBox1.Text & "1" End Sub Private Sub AboutToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles AboutToolStripMenuItem.Click MsgBox("تصميم وبرمجة أوفيسنا مصطبة الحبايب -_-") End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click TextBox1.Text = TextBox1.Text & "2" End Sub Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click TextBox1.Text = TextBox1.Text & "3" End Sub Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click TextBox1.Text = TextBox1.Text & "4" End Sub Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click TextBox1.Text = TextBox1.Text & "5" End Sub Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click TextBox1.Text = TextBox1.Text & "6" End Sub Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click TextBox1.Text = TextBox1.Text & "7" End Sub Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click TextBox1.Text = TextBox1.Text & "8" End Sub Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click TextBox1.Text = TextBox1.Text & "9" End Sub Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click TextBox1.Text = TextBox1.Text & "0" End Sub Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click TextBox1.Text = TextBox1.Text & "." End Sub Private Sub CopyToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles CopyToolStripMenuItem.Click TextBox1.SelectAll() TextBox1.Copy() End Sub Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click 'يكرر هذا الكود في العمليات الحسابيةكلها 'هنا يتم حجز قيمة التكست بوكس داخل المتغر الاول nn1 = Val(TextBox1.Text) 'مسح قيمة التكست بوكس TextBox1.Text = "" 'حجز العملية الحسابية داخل المتغير الخاص بالعملية الحسابية nn = "/" End Sub Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click 'حجز القيمة الثانية في المتغير الخاص بالقيمة الثانية nn2 = Val(TextBox1.Text) 'هنا نستخدم if & elsif لتحديد نوع العملية وحسابها واخراج الناتج 'بمعنى اذا كان المتغير الخاص بالعملية الحسابية ان ان يساوي (-) اذا متغير القيمية الاولى - متغير القيمة الثانية If nn = "-" Then TextBox1.Text = nn1 - nn2 ElseIf nn = "+" Then TextBox1.Text = nn1 + nn2 ElseIf nn = "*" Then TextBox1.Text = nn1 * nn2 ElseIf nn = "/" Then TextBox1.Text = nn1 / nn2 End If End Sub Private Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Click nn1 = Val(TextBox1.Text) TextBox1.Text = "" nn = "*" End Sub Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click nn1 = Val(TextBox1.Text) TextBox1.Text = "" nn = "-" End Sub Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click nn1 = Val(TextBox1.Text) TextBox1.Text = "" nn = "+" End Sub Private Sub ExitToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ExitToolStripMenuItem.Click End End Sub Private Sub Button17_Click(sender As Object, e As EventArgs) Handles Button17.Click 'البدأ من جديد بالغاء قيمة التكست وقيم المتغيرات TextBox1.Text = "" nn = Nothing nn1 = Nothing nn2 = Nothing End Sub End Class طبعا نفس الآله الحاسبة مجرد تبديل الكود الخاص بالزر = & + & - & / & * مرفق المثال يتبع Calculator Yasser - Copy.rar

السلام عليكم ورحمة الله وبركاته السادة الافاضل اساتذتي واخواني الكرام تم بفضل الله التوصل لطريقة التحكم بطابعة الفواتير ودرج النقدية الخاص بالكاشير وبعد اذنكم سود اسرد الموضوع من البداية حتي يسهل على الاخوة الاعضاء التوصل اليه بمشاركة واحدة . ادوات جهاز الكاشير : ( طابعة فواتير - درج نقدية – سكانر ) الاسكانر لا يحتاج لشرح ، وتم مناقشته من قبل في مواضيع كثيرة ، ولكن موضوعنا اليوم والذي لم يتم مناقشته بافاضة هو طابعة الفواتير ودرج النقدية . 1 – الطابعة الحرارية " طابعة الفواتير" : ومنها انواع عديدة ولكن اشهرها نوع ايبسون ، وتحتوي على 3 منافذ ( منفذ كهرباء – منفذ usb " من خلالة يتم تعريف خصائص واعدادات الطابعة وهي نقطة هامة جداااا والذي يترتب عليه الاداء لاحقا " - منفذ درج النقدية " وهو عبارة عن منفذ نفس منفذ الهاتف الارضي ويتم توصيلها بالطابعة من خلال واير يشبة واير الهاتف الارضي ..طرفة الاول بالطابعة والطرف الاخر باسفل الدرج ، وتكمن فكرة فتح الدرج في ارسال شحنة كهربائية من الطابعة عند الطباعة الي الدرج ليقوم بفتحة " 2 – درج النقدية : ويحتوي علي منفذ واحد فقط ويكون اسفله ، وهو المنفذ الذي يتصل بيه للطابعة والمذكور اعلاه . الاستفسارات المطروحة : س1 : طريقة فتح درج النقدية بدون طباعة ؟ س2 : طريقة تحديد تقارير معينة لفتح الدرج معها ، وتقارير اخري لعدم فتح الدرج معها . اول واهم شيء نقوم بتعريف الطابعة على الكمبيوتر من خلال الـــ CD المرفق جـ1 : قام الاستاذ الفاضل السيد جمال جزاه الله كل خير بوضع كود لفتحة وتم تجربتة بعد تعريف الطابعة وهو يعمل تمام الحمد لله " موجود بالمشاركة السابقة " . كود الاستاذ السيد جمال لفتح درج النقدية بدون طباعة . فتح الكاشير.rar جـ2 : نقوم بتحديد التقرير المطلوب طباعتة مع فتح الدرج او عدم فتح الدرج ثم نفتح التقرير بوضع التصميم ونتبع الخطوات المشار اليها بالصور . اتمني ان يكون الشرح واضح ...... وسامحوني على الاطالة واي استفسار انا حاضر وللسادة المشرفين الافاضل اتخاذ ما يرونه مناسبا في تغيير العنوان الاساسي حتي يسهل الوصول اليه علي سبيل المثال " التحكم فى طابعة الفواتير ودرج النقدية الخاص بالكاشير " هذاا .... وما توفيقي الا بالله . مع كل الشكر والتقدير للمنتدانا الغالــــي

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

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

السلام عليكم ورحمة الله وبركاته حبيبي الغالي أبو أسيل مروركم شرفني..ما أنا إلا تلميذ بمدرستكم وخير شاهد أكواد الآلة الحاسبة"فيجوال بيزك 2012 ". أرجو الله أن يبقيكم ذخرا لنا والسلام عليكم.

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

السلام عليكم ورحمة الله وبركاته ..أخي الحبيب أبو البراء... كود رائع قمت بوضعه بدلاً من الكود السابق .. أدى العمل المطلوب" وفق التاريخ"بشكل صحيح.. جزاكم الله خيراً ونفع بعلمكم...آمين...بارك الله.

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

بسم الله ما شاء الله ملف رائع وممتاز .. ومش بس بالمعادلات لا وبالأكواد كمان .. جزاكم الله خيراً أخي الحبيب ابو يوسف ومشكور على الموضوع الرائع والممتع واصل بلا فوااااااااااااااااااصل .. هكذا نريد الجميع أن يقدموا ما تعلموه بأسلوبهم تقبل وافر تقديري واحترامي

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

بارك الله فيك أخي المتميز أحمد الفلاحجي وجزيت خير الجزاء تقبل وافر تقديري واحترامي

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله في أحد الموضوعات لأحد الأخوة الأعضاء كان قد طلب كيفية إرسال رسالة بريد إلكتروني (إيميل Email) باستخدام ملف إكسيل واليوم أقدم لكم الطريقة بالتفصيل من الألف إلى الياء ... وإن شاء الله تكون الطريقة ناجحة ومفيدة للجميع الخطوات اللازمة لعمل المطلوب : فتح حساب جديد على الـ Gmail إذا لم يكن لديك حساب وكيفية إنشاء حساب جديد مشروحة بالصور : نقوم بفتح برنامج الـ Outlook من قائمة Start ثم All Programs وندخل بيانات الحساب الذي أنشيء على الـ Gmail .. بهذا الشكل : وأخيراً وبعد عملية إنشاء الحساب وربط برنامج الـ Outlook بحساب الـ Gmail .. نقوم بفتح ملف إكسيل وفي العمود الأول ندخل الإيميلات المراد إرسال بريد إلكتروني لها .. وفي العمود الثاني نكتب اسم صاحب الايميل (اختياري) وفي العمود الثالث نكتب محتوى الرسالة المراد إرسالها .. وهذا هو الكود الذي سيقوم بمهمة إرسال رسائل البريد الالكتروني دفعة واحدة لكل الإيميلات المسجلة لديك .. ملحوظة مهمة جداً : من خلال محرر الأكواد يتم إضافة المكتبة التالية Microsoft Outlook Object Library من القائمة Tools ثم References .. Sub Mail_To_Friends() Dim SendTo As String Dim ToMSg As String Dim I As Integer For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row SendTo = ThisWorkbook.Sheets(1).Cells(I, 1) If SendTo <> "" Then ToMSg = ThisWorkbook.Sheets(1).Cells(I, 3) Send_Mail SendTo, ToMSg End If Next I MsgBox "Done ...", 64 End Sub Sub Send_Mail(SendTo As String, ToMSg As String) Dim OutlookApp As Object Dim OutlookMail As Object Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) With OutlookMail .To = SendTo .CC = "" .BCC = "" .Subject = "Hello Officena" .Body = ToMSg .Send End With Set OutlookMail = Nothing Set OutlookApp = Nothing End Sub وأخيراً إليكم الملف المرفق مطبق فيه الكود وفيه نموذج لشكل ورقة العمل .. ويوجد زر أمر لعملية الإرسال .. وهذا هو الملف تقبلوا وافر تقديري واحترامي كان معكم أخوكم أبو البراء من منتدى أوفيسنا Send Mass Emails Through Outlook Using Excel VBA YasserKhalil Officena.rar

السلام عليكم ورحمه الله وبركاته مرفق برنامج ادارة وكالات الفاكهه والخضار تم تصميم البرنامج بطلب خاص ، تم الانتهاء من البرنامج بنسبة 90 % اقوم برفعه لاخذ ارائكم ومقترحاتكم وملاحظاتكم وتوجيهاتكم كلمة السر لاى مستخدم 123 ملحوظة : البرنامج مدفوع لذا النسخة المرفقة MDE برنامج وكالة فواكه.rar

اتفضلوا اخوانى اخر رابطين فى البرنامج إضغط هنا للتحميل 5 إضغط هنا للتحميل 6 ان شاء الله يظبط معكم البرنامج لنتابع الشرح مع ابو اسيل تقبلوا تحياتى ووفقكم الله لما يحبه ويرضاه وتصبحون على خير قد نال منى النوم

السّلام عليكم و رحمة الله و بركاته إخواني الأفاضل : ياسر العربي ياسر خليل أبو البراء محمد حسن المحمد أحمد الفلاحجي و كل من يشاركنا عرس الدوت نات البهيج .. من باب زيادة الخير .. خيريْن .. و الدّال على الخير كفاعله لمن يعاني من روابط التّحميل .. و ضعف النت .. موقع منذ حوالي 3 سنين و أنا أستعمله ..لتحميل نسخ الوينداوز بجميع أنواعها و لغاتها .. لجميع البرامج الكاملة و الكمال لله .. و الآن لجميع نسخ الفيجوال بيسك باختلاف إصدارتها و لغاتها .. لم يصادفني أنْ وجدت يوما ملفا فاسدًا إطلاقًا .. و الوحيد الذي أستعمله منذ سنوات عن تجربة .. التّحميل بالتورنت .. و أنا الآن بصدد تحميل نسخة 2012 أنجليزية لعل و عسى نحتاجها .. سأضعها على دكّة الاحتياط .. رابط الموقع .. للتّحميل إضغط على البرنامج المراد تحميله .. ثم عند الانتقال لصفحة البرنامج .. إضغط على رمز المغناطيس http://undertorrents.com/usearch/visual studio 2012/ إحتراماتي

تفضل يا سيدي الفاضل الكود: Private Sub TreeView1_NodeClick(ByVal Node As Object) On Error GoTo err_TreeView1_NodeClick 'lblItemCode.Caption = "" 'If Node.Key <> "Root" Then ' lblItemCode.Caption = Mid(Node.Key, InStr(Node.Key, "_") + 1) 'End If 'lblPath.Caption = Node.FullPath ' Dim colon As Integer ' colon = InStr(Node.Text, ":") ' Me.txt3 = Mid(Node.Text, 1, colon - 1) ' Me.Txt4 = Mid(Node.Text, colon + 1) ' colon = InStr(Node.Child, ":") ' If colon = 0 Then ' Me.txt1 = Val(Mid(Node.Child, 1, colon - 1)) + Node.Children ' Me.txt1 = "" ' Else ' Me.txt1 = Val(Mid(Node.Child, 1, colon - 1)) + Node.Children ' End If If Node.Text = "فتح نموذج frm1" Then DoCmd.OpenForm "frm1" ElseIf Node.Text = "فتح نموذج frm2" Then DoCmd.OpenForm "frm2" End If On Error Resume Next Debug.Print "node.Child; " & Node.Child Debug.Print "node.Children; " & Node.Children Debug.Print "node.Expanded; " & Node.Expanded Debug.Print "node.FirstSibling; " & Node.FirstSibling Debug.Print "node.FullPath; " & Node.FullPath Debug.Print "node.Index; " & Node.Index Debug.Print "node.Key; " & Node.Key Debug.Print "node.LastSibling; " & Node.LastSibling Debug.Print "node.Next; " & Node.Next Debug.Print "node.Parent; " & Node.Parent Debug.Print "node.Previous; " & Node.Previous Debug.Print "node.Root; " & Node.Root Debug.Print "node.Selected; " & Node.Selected Debug.Print "node.Sorted; " & Node.Sorted Debug.Print "node.Tag; " & Node.Tag Debug.Print "node.Text; " & Node.Text Debug.Print "----------------------" Exit Sub err_TreeView1_NodeClick: If Err.Number = 91 Then colon = Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر 342.AZ_TreeView_ListBox.accdb.zip

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

السلام عليكم أخي الحبيب سعد عابد جعلك الله من سعداء العابدين في الدنيا والآخرة..جزاكم الله خيرا على طيب كلماتكم وأشكركم على دعائكم لي.. وما أنا إلا بكم ومنكم..لم أخضع لدورات أو أتعلم على الحاسب إلا ما حصلته من أساتذتي الكرام في منتدى أوفيسنا...واسمح لي أن أخمن جواب سؤالك ريثما يجيب عنه أخونا الحبيب أبو البراء فيسعد بطلابه.. 1- Value: قيمة تاريخ البدء. 2- Value2:قيمة تاريخ الانتهاء. 3- ReDim:إعادة الحلقة التكرارية من جديد( وهذه لست متأكدا منها)..نرجو التدقيق في هذه الإجابات لننطلق منها. والسلام عليكم ورحمة الله وبركاته.

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

أخي الفاضل دالة vlookup لا تاتي ببيانات من خلف العمود المصدر ولزلك تم نسخ قيم العمود الأول الى العمود الاخير في الشيت الاول في الخلية j2 = a2 ونسخ المعادلة في الشيت الثاني تم تحويل القيم النصية الى قيم رقمية بدالة value وتم استخدام المعادلة المطلوبة وارجو ان يكون هذا هو المطلوب fff.rar

السلام عليكم 1. من المعروف ان تنسيق النص في مربع القائمة ListBox هو من اليسار الى اليمين ، مشكلة كانت تصادفني دائما ، وهو تنسيق القيم في مربع القائمة لتكون من اليمين الى اليسار بالنسبة للغة العربية (طريقة تغيير مربع القائمة الى مربع تحرير ونص ، ثم عمل التنسيق عليه من اليمين الى اليسار ، ثم اعادته الى مربع قائمة لا يعمل معظم الوقت) ، موقع http://www.lebans.com والذي يحتوي على مالذ وطاب عنده طريقه لهذا التنسيق: http://www.lebans.com/justicombo.htm كذلك. 2. ونفس المشكلة مع موضوع تنسيق الشجرة TreeView من اليمين الى اليسار. النتيجة: و وطريقة العمل ، يوضع هذا الكود في وحدة نمطية: Option Compare Database Option Explicit #If VBA7 And Win64 Then '64 bits Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Long, ByVal bErase As Long) As Long Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr Public Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr Public Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr Dim hwnd As LongPtr #Else '32 bits Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Public Declare Function GetFocus Lib "user32" () As Long Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Dim hwnd As Long #End If Public Const GW_CHILD = 5 Public Const WS_EX_LAYOUTRTL = &H400000 Public Const GWL_EXSTYLE = (-20) Function RTL_Set(frm As Form, ctl As Control) Dim varHwnd As Variant Dim OldLong As Long frm.SetFocus ctl.SetFocus varHwnd = GetFocus() OldLong = GetWindowLong(varHwnd, GWL_EXSTYLE) SetWindowLong varHwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL InvalidateRect hwnd, 0, False End Function Function RTL_SetTree(frm As Form, ctl As Control) Dim OldLong As Long OldLong = GetWindowLong(ctl.hwnd, GWL_EXSTYLE) SetWindowLong ctl.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL InvalidateRect hwnd, 0, False End Function ' ' From http://www.microsoft.com/middleeast/msdn/faq.aspx ' 'Place OnLoad of the Form ' Dim OldLong As Long 'For Form ' OldLong = GetWindowLong(Me.hwnd, GWL_EXSTYLE) ' SetWindowLong Me.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For List ' OldLong = GetWindowLong(List1.hwnd, GWL_EXSTYLE) ' SetWindowLong List1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For The StatusBar ' OldLong = GetWindowLong(StatusBar1.hwnd, GWL_EXSTYLE) ' SetWindowLong StatusBar1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For TreeView ' Dim nodX As Node ' Set nodX = TreeView1.Nodes.Add(, , "R", "Root") ' Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C1", "Child 1") ' Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C2", "Child 2") ' Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C3", "Child 3") ' Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C4", "Child 4") ' nodX.EnsureVisible ' OldLong = GetWindowLong(TreeView1.hwnd, GWL_EXSTYLE) ' SetWindowLong TreeView1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For ListView ' OldLong = GetWindowLong(ListView1.hwnd, GWL_EXSTYLE) ' SetWindowLong ListView1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For ProgressBar ' ProgressBar1.Value = 50 ' OldLong = GetWindowLong(ProgressBar1.hwnd, GWL_EXSTYLE) ' SetWindowLong ProgressBar1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For ToolBar ' mhwnd = GetWindow(Toolbar1.hwnd, GW_CHILD) ' OldLong = GetWindowLong(mhwnd, GWL_EXSTYLE) ' SetWindowLong mhwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False في اسفل الكود انا تركت الكود لبقية الاشياء اللي يمكن عملها من اليمين الى اليسار. اما تنفيذ التنسيق لمربع القائمة ، فهو وضع هذا الكود عند تحميل النموذج الذي يحتوي على هذا المربع (وهنا اسم حقل مربع القائمة هو List0_RTL ) : 'ListBox RTL Call RTL_Set(Me, List0_RTL) وتنسيق الشجرة ، فهو وضع هذا الكود عند تحميل النموذج الذي يحتوي على الشجرة (وهنا اسم الشجرة هو TreeView1) : 'TreeView RTL Call RTL_SetTree(Me, TreeView1) وللأمانة العلمية ، فاني استخدم قاعدة البيانات التي وضعها الاخ محمد في الرابط: http://www.officena.net/ib/index.php?showtopic=60781 جعفر تعديل 1: 18-11-2021 ، جعل البرنامج يعمل على النواتين 32بت و 64 بت 54.RTL_TreeView_ListBox_32bits_n_64bits.accdb.zip

اخي جرب الملف المرفق fff.rar

اذا تريد تريح نفسك من هذه الشغلة كلها ، فالرابط اعلاه فيه برنامج من مايكروسوفت يمكنك انزاله ، وسيقوم بالعملية بطريقة ثانية ، وهذا رابط البرنامج: http://go.microsoft.com/fwlink/?LinkId=263512 اما اذا الجواب عن سؤالك ، فتفضل: 1. . 2. . 3. . 4. . 5. . 6. . 7. . 8. . 9. . 10. . 11. . 12. . 13. . جعفر

السلام عليكم أخي الحبيب أبو بسملة جزاكم الله خيرا على كلماتكم العطرة ومروركم الكريم الذي شرفتمونا به. كلماتكم الطيبة حافز لنا للمضي قدما ...بحثا ودرسا وتنقيبا عن الدرر المكنونة في أمهات الكتب " google"التي جمعت بين طياتها كل علوم وآداب وسير البشرية...والسلام عليكم.

في الصفحة 1 غامود B استعمل هذه المعادلة (تحويل النص الى ارقام) و لم افهم ماذا تريد بعد ذلك =RIGHT(A2,5)*1 في الصفحة 1 غامود B استعمل هذه المعادلة (تحويل النص الى ارقام) و لم افهم ماذا تريد بعد ذلك =RIGHT(A2,5)*1

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

اخوانى الكرام تفضلوا حملوا الجزء الثالث لحين رفع باقى 7 اجزاء إضغط هنا للتحميل 3 تقبلوا تحياتى

السلام عليكم ورحمة الله تم عمل المطلوب بالمعادلات وتعديلات على بعض تنسيقات الملف وإضافة نطاقات بالتسمية للضرورة... بعض الشيتات تمت حمايتها بكلمة سرية حتى لا تمسح المعادلات المستعملة بالخطأ... الكلمة السرية للحماية هي : hb (كالعادة) أرجو أن تفي هذه التعديلات الغرض المطلوب... بن علية الداخل + المباع + الرصيد.rar

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

اخي الكريم توكل يرجى توضيح المشكلة التى صادفتك بالصور والتوضيح وتوضيح نوع النظام الذيي تعمل عليه لحل مشكلتك

بارك الله فيك أخي الحبيب سعد عابد وجزيت خيراً بمثل ما دعوت لي ومشكور على اهتمامك بأمر ظهور القناة في البحث ..بارك الله فيك على نيتك الحسنة تقبل وافر تقديري واحترامي

أخي الكريم خير الايمان هل تقصد استخدام برنامج Outlook لإرسال رسالة لبريد الكتروني؟

اتفضلوا اخوانى الكرام سوف اضع رابط رابط بعد تحميله لكى تحملوه عما يترفع الاخر إضغط هنا للتحميل 2 تقبلوا تحياتى

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

وعليكم السلام غيّر الكود السابق الى هذا الكود: If Me.PrintCount = 1 Then curTotal = curTotal + nz(Me.الثمن,0) جعفر

وعليكم السلام هذا الكود يقوم بالعمل: Option Compare Database Option Explicit 'Optional, but recommended for every module. Dim curTotal As Currency 'Variable to sum [Amount] over a Page. ' 'From http://allenbrowne.com/ser-11.html ' Private Sub PageFooterSection_Format(Cancel As Integer, FormatCount As Integer) Me.PageTotal = curTotal End Sub Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer) curTotal = 0 'Reset the sum to zero each new Page. End Sub Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer) If Me.PrintCount = 1 Then curTotal = curTotal + Me.السعر End Sub . . . جعفر 339.اجمالي السعر.mdb.zip

وعليكم السلام انا شرحت موضوع الامر NZ بطريقة موسعة شوي: جعفر

أخوي حسين ايش رايك نطلع مثل ما يقولون Out of the Box ، وننظر للموضوع بشكل ابعد من الاكسس فقط ايش رايك بهذا البرواز: . وهكذا عملته: بحثت في الانترنت عن برواز ، وانزلته ، وكان عرضة اطول من طوله ، فاستعملت برنامج رسومات وادرته 90 درجة وحفظته ، ضيّقت الكائنات في التقرير ، علشان البرواز يبين من كل الجهات ، وبس : . وعلشان حجم البرنامج لا يكبر بسبب الصورة ، احفظ الصورة في مجلد البرنامج واربط الصورة ، بدل ان تجعلها مضمنه جعفر 338.2.برنامج الفواتير.mdb.zip

السلام عليكم لا أدري ما المشكلة حتى لم تعمل بشكل صحيح تقبل تحياتي موعدنا غداً إن شاء الله تعالى

أخي الحبيب ياسر العربي يبدو أن جهازم مصاب بفيروس ..يرجى فحص الملفات قبل رفعها ..!

تفضل اخي الكريم Enable Macros.rar

السّلام عليكم و رحمة الله و بركاته أخي الغالي " محمّد حسن المحمّد " .. و الله جد آسف لما حصل و للجهود الذّاهبة سُدًى .. أنا كذلك كل شيء متلخبط عندي .. و لم أستقر على نسخة لحد الآن .. جرّبت هذه .. حذفت الأخرى .. عدّلت من هنا .. تلخبطت من هناك .. لم أعد تسطيب الوينداوز لحين إستقراري على نسخة جيّدة .. سأحاول مع جميع الإخوة الأكارم إيجاد نسخة مع إمكانيّة تقسيم أجزائها للتّحميل سنرمي الكرة بمرمى أخانا أبو قلب حنون و صدر رحب " ياسر العربي " فائق إحتراماتي

33 _ فك حماية محرر الاكواد وحماية اوراق العمل _ الاستاذ / ياسر العربى 34 _ فك حماية ملف الاكسيل من الخارج _ الاستاذ / ياسر العربى 35 _ حماية محرر الأكواد من فك الحماية حتى لو عرف الهاكر كلمة السر _ الاستاذ / ياسر خليل أبو البراء

وجدت حل للمشكلة وياريت تعجبك انظر المرفق فاتورة بيع.rar

نستطيع ان نضع الكود في الحدث ... بعد التحديث ... للموديل و السعر و العدد ... فاي حقل منهم يكون الاخير يتم النقل ...

الله يسعد أوقاتكم جميعا زيادة الخير خير - بدون أن أتخطى - حدودي مع أساتذتي الكرام تحياتي لكم جميعا و دوما منك نستفيد حل بطريقة أخرى بالمعادلات - أرجو أن يكون المطلوب معادلة لحساب عدد كل جنسية مع اهمال التكرار من خلال استخدام Student ID.rar

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

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