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

السّلام عليكم و رحمة الله و بركاته أستاذي الغالي " خالد الشّاعر " عملت تغيير بملف أستاذنا القدير " ياسر خليل أبو البراء " .. بارك الله فيه و جزاه الله خيرًا حاضرًا و غائبًا و زادها بميزان حسناته قمت بتحريك وضعية الجدول لترى الفرق بين الملف الأول و هذا الملف .. لاحظ أنّ العمود الخاص بالتّرقيم هو العمود التّاسع العمود الخاص بالتاكست بوكس 1 هو العمود العاشر .. وهكذا تصاعديًا .. الصف الذي بدأنا به الترقيم هو الصف الرّابع .. أدخل لو سمحت لمحرّر الأكواد واكتشف الفرق بين هذا الملف و الملف الأصلي الأول ستجد أنّ الأمر أبسط ممّا تتخيّل فائق إحتراماتي UserForm TextBox Input YasserKhalil.rar

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

أخي الكريم أبو راكان إليك الكود التالي يتم وضعه في موديول عادي Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function GetWindowRect Lib "User32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Const GWL_STYLE = (-16) Private Const WS_CAPTION = &HC00000 Private Const WS_MAXIMIZEBOX = &H10000 Private Const WS_MINIMIZEBOX = &H20000 Private Const WS_SYSMENU = &H80000 Private Enum ESetWindowPosStyles SWP_SHOWWINDOW = &H40 SWP_HIDEWINDOW = &H80 SWP_FRAMECHANGED = &H20 SWP_NOACTIVATE = &H10 SWP_NOCOPYBITS = &H100 SWP_NOMOVE = &H2 SWP_NOOWNERZORDER = &H200 SWP_NOREDRAW = &H8 SWP_NOREPOSITION = SWP_NOOWNERZORDER SWP_NOSIZE = &H1 SWP_NOZORDER = &H4 SWP_DRAWFRAME = SWP_FRAMECHANGED HWND_NOTOPMOST = -2 End Enum Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Sub ShowTitleBar(bShow As Boolean) Dim lStyle As Long Dim tRect As RECT Dim xlHnd As Long xlHnd = Application.hwnd GetWindowRect xlHnd, tRect If Not bShow Then lStyle = GetWindowLong(xlHnd, GWL_STYLE) lStyle = lStyle And Not WS_SYSMENU lStyle = lStyle And Not WS_MAXIMIZEBOX lStyle = lStyle And Not WS_MINIMIZEBOX lStyle = lStyle And Not WS_CAPTION Else lStyle = GetWindowLong(xlHnd, GWL_STYLE) lStyle = lStyle Or WS_SYSMENU lStyle = lStyle Or WS_MAXIMIZEBOX lStyle = lStyle Or WS_MINIMIZEBOX lStyle = lStyle Or WS_CAPTION End If SetWindowLong xlHnd, GWL_STYLE, lStyle Application.DisplayFullScreen = Not bShow SetWindowPos xlHnd, 0, tRect.Left, tRect.Top, tRect.Right - tRect.Left, tRect.Bottom - tRect.Top, SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED End Sub Sub Hide_Application_Title() ShowTitleBar False End Sub Sub Show_Application_Title() ShowTitleBar True End Sub يمكنك تنفيذ إخفاء شريط العنوان باستدعاء الماكرو المسمى Hide_Application_Title ولاظهار العنوان مرة أخرى استدعي الماكرو المسمى Show_Application_Title

انا كنت فاكر مشكلتك ترتيب بس التكست بوكس جاري عمل اللازم انتظر تفضل اخي ترتيب الفورمة.rar

حفظك الله اخي ياسر خليل كلنا نتعلم من بعض احبك الله الذي احببتنا فيه تقبل تحياتي وشكري لشخصكم النبيل

أخي الغالي أبو نصار لا حرمنا الله من إبداعاتك ولا منك أبداً تقبل وافر تقديري وحبي في الله

السلام عليكم ان كان كجمال واعطاء مساحه احبذ الكود التالي عند فتح المصنف "Auto_Open" ينفذ اخفاء عند اغلاق المصنف "Auto_Close" ينفذ اظهار Sub Auto_Open() Ali_Acc False End Sub Sub Auto_Close() Ali_Acc True End Sub Sub Ali_Acc(Bll As Boolean) With Application .DisplayFormulaBar = Bll .ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"" ," & Bll & ")" .ActiveWindow.DisplayHeadings = Bll If Bll Then .ThisWorkbook.Close SaveChanges:=Not Bll End With End Sub

السلام عليكم انسخ الكود التالي الى حدث الورقة المسماه "الصفحة 2" Private Const My_Rng_Adrs As String = "$A$3:$D$55000" Private Const Area_Prnt As String = "$C$7:$E$15" Dim Ar_1() As Variant Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Range("A7:A1000"), Target) Is Nothing Then MsgBox "" If Target <> Empty Then Dim Wr As Worksheet: Set Wr = Sheets("الصفحة 3") With Wr .Cells(7, 4) = Target .Cells(8, 4) = Target.Offset(0, 1) .Cells(9, 4) = Target.Offset(0, 2) .PageSetup.PrintArea = Area_Prnt .PrintPreview .Cells(7, 4) = "": .Cells(8, 4) = "": .Cells(9, 4) = "" End With Cancel = False Set Wr = Nothing End If End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$5" Then Range(Range("A7"), Range("D7").End(xlDown).Resize(1, 4)).ClearContents If Ali_Serch(CStr(Target), 1) = True Then Range("A7").Resize(UBound(Ar_1, 1), UBound(Ar_1, 2)) = Ar_1() End If Erase Ar_1 End If If Target.Address = "$C$5" Then Range(Range("A7"), Range("D7").End(xlDown).Resize(1, 4)).ClearContents If Ali_Serch(CDate(Target), 3) = True Then Range("A7").Resize(UBound(Ar_1, 1), UBound(Ar_1, 2)) = Ar_1() End If Erase Ar_1 End If If Target.Address = "$E$5" Then Range(Range("A7"), Range("D7").End(xlDown).Resize(1, 4)).ClearContents If Ali_Serch(CStr(Target), 4) = True Then Range("A7").Resize(UBound(Ar_1, 1), UBound(Ar_1, 2)) = Ar_1() End If Erase Ar_1 End If End Sub Private Function Ali_Serch(Trget As String, Col As Long) As Boolean Dim Ar Dim Rng As Range Dim C, x, i, XX, Xi, Xt Dim Data_1 Dim Wrsh As Worksheet Set Wrsh = Sheets("الصفحة 01") With Wrsh If Col = 3 And Not IsDate(Trget) Then MsgBox "صيغة التاريخ التي كتبتها غير صحيحه !!", vbExclamation, "إدخال خاطئ !!": Exit Function Set Rng = .Range(My_Rng_Adrs) Ar = Rng.Value ReDim Preserve Ar_1(1 To Rng.Rows.Count, 1 To 4) For x = LBound(Ar, 1) To UBound(Ar, 1) XX = Ar(x, Col): Xi = Trim(Ar(x, 1)): Xt = Trim(Ar(x, 2)) If Col = 3 Or Col = 4 Then Data_1 = Val(XX) ElseIf Col = 1 Then Data_1 = CStr(Xi & " " & Xt) ElseIf Col = 3 Then Data_1 = CDate(DateSerial(Year(XX), Month(XX), Day(XX))) End If If Not Data_1 = Empty Then If Data_1 Like Trget Then Ali_Serch = True i = i + 1 For C = 1 To 4 Ar_1(i, C) = IIf(C = 3, Format(Ar(x, C), "dd/mm/yy"), CStr(Ar(x, C))) Debug.Print Ar(x, C) Next C End If End If Next x End With Set Rng = Nothing: Set Wrsh = Nothing End Function بعد كتابة الاسم او التاريخ او رقم التسجيل اضغط انتر ستظهر النتائج اسفل جدول البحث انقر مرتين على نتيجة البحث في العمود "A" الاسم الاول سيطبع لك النتيجه جرب وابلغنا بالنتائج تحياتي تم اضافة المرفق وبه الكود اعلاه تجربة_111.rar

اخي الكريم ياسر خليل الفائده من استخدام الكود بالطريقه التي سردتها بالمشاركه السابقه ان لاتحمل كاهل الملف بالهيبرلينك حتى يصبح بطيئ جدا عند الفتح وان ولايوقف عند الخليه 650000 كحد اعلى للهيبرلينك فقط بل ينفذ الكود حتى يصل عند التوليف "ZZZZ" كأنه كتب عنوان على الخلايا فقط ونستخدم العنوان كهيبر لينك عند النقر عليه وبالامكان استخدام الكود لايحذف الهيبرلينك الا حين يصل الى الحد الاعلى بإضافة بسيطه هذه اضافه لااحبذها الافضل التعامل مع كل خليه كي لا يكبر حجم الملف ويصبح بطيئ هذا المرفق وبه الكود لحدث الصفحه وكود انشاء العناوين If ActiveSheet.Hyperlinks.Count >= 65530 Then For Each R In ActiveSheet.Hyperlinks If R.TextToDisplay > "" Then R.Delete: Exit For Next End If شرح كود الهايبر لنك_111.rar

السلام عليكم ورحمة الله أخي الكريم ياسر، هذه محاولة في المرفق بالاستعانة بعمود إضافي (ملون بالأخضر) فيه معادلة تقوم بحساب مجموع: (عدد مرات ظهور الرقم 1 في الصف مضروب في 1000) و (عدد مرات ظهور الرقم 2 في الصف مضروب في 100) و (عدد مرات ظهور الرقم 3 في الصف مضروب في 10) و (عدد مرات ظهور الرقم 4 في الصف مضروب في 1) بالنسبة للأعمدة المعنونة بـ "Rank" ثم في العمود "Total Rank" وضعت الدالة RANK لترتيب المجاميع المحصل عليها... (بالتأكيد معادلات المجاميع تتغير حسب عدد المراتب)... بن علية Rank.rar

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

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

السلام عليكم ورحمة الله أخي الكريم عملت بما في ملفك المرفق، أي بمجرد اختيار الاسم من المنسدلة يتم طباعة البيانات حسب شيت "صفحة الطباعة"... أرجو أن يكون المطلوب... بن علية تجربة.rar

السلام عليكم هكذا بيكون Private Sub Workbook_SheetActivate(ByVal Sh As Object) Ap_A False With Sh.UsedRange .Columns.EntireColumn.AutoFit '' الاعمدة .Rows.EntireRow.AutoFit '' الصفوف .Borders.Color = 1 '' البوردر With .Font .Name = "Times New Roman" '' اسم الخط .Size = 10 '' حجم الخط End With End With Ap_A True End Sub Private Function Ap_A(Bn As Boolean) With Application .Calculation = IIf(Bn, -4105, -4135) .ScreenUpdating = Bn .EnableEvents = Not Bn End With End Function

السّلام عليكم و رحمة الله و بركاته أخي الكريم " أبو عبد الرّحمن البغدادي " .. يبدو أنَّ قدري مرتبط بقدرك لأنّي غالبًا ما أشارك بمواضيعك .. كان يمكن أن أرسل لك الملف جاهزًا لكن فضّلت أخي الفاضل أن تحاول إنجاز ذلك بنفسك .. لاحظ أخي الكريم في شيت البيانات أنّ عمود صافي الرّاتب هو العمود N وهو العمود رقم 14 .. نذهب الآن إلى محرّر الأكواد .. سنجد أنّ التاكست بوكس الخاصّة بصافي الرّاتب هي التاكست بوكس رقم 10 .. ندخل إلى الأكواد الاآن و نلاحظ .. شاهد الصورة يجب أن تكون التاكست بوكس 10 مرتبطة مع العمود 14 لاحظ السّهم الأحمر و السّهم الأخضر بالصورة رقم 3 .. نجد أنّ التاكست بوكس 10 مرتبطة مع العمود 10 المشار إليه بالسّهم الأخضر .. جرّب تغيير الرقم 10 المشار إليه بالأخضر إلى الرّقم 14 و ستتغيّر النتيجة .. إتّبع نفس المنوال لترتيب أمورك .. و الله المستعان فائق إحتراماتي

السلام عليكم المرفق الاول الشرح والاخر الملف شرح_5.rar البحث بين تاريخين_A.rar

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

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

المشكله عندك اخي هل انت مفعل امان الماكرو منخفض ام لا ؟ اتبع الفيديو في المرفق اذا لاتعرف الطريقه لتفعيل الماكرو تفعيل الماكرو.rar

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

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

بالطبع اخي مختار حسين لان الاسم خلال الفترة لم يذكر اكثر من رمره لذا لايوجد تكرار ! اما ماذكرته : يوجد خلل بسيط في كود حدث "Calendar1_Click" في الفورم المسمى "Celndr_Ali" Ali_Rep.Controls(A_Se).Value = Calendar1.Value يستبدل بالتالي لعمل عليه فورمات ليأتي بالتاريخ بالشكل الذي نريده "yyyy/mm/dd" Ali_Rep.Controls(A_Se).Value = Format(Calendar1.Value, "yyyy/mm/dd") اذهب الى كود "ListBox1_Click" في السطر الحلقة التكراريه For ii = 1 To .ListCount - 1 الصح بيكون من 0 كأول سطر في الليست بوكس كالتالي For ii = 0 To .ListCount - 1 اذهب الى خصائص فورم "Ali_Rep" وروح الى خاصية "RightToleft" قيمتها False حولها الى True ان شاء الله ستظهر كما تريد او ضيف السطر التالي في حدث "UserForm_Initialize" Me.RightToLeft = True المرفق بعد تعديل ماذكر مسبقاً البحث بين تاريخين_A2.rar

الطلب.rar

جرب هذا الملف كشف حساب salim.zip

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

أخي الكريم خالد إليك التعديل التالي عله يفي بالغرض Edit UserForm.rar

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

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

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

أخي الغالي عبد العزيز البسكري بارك الله فيك وجعله في ميزان حسناتك ما أجمل البساطة (خصوصاً لو كانت مخلوطة بالبطاطا)

السّلام عليكم و رحمة الله و بركاته جرّب هذا الملف أخي الكريم " أبو عبد الرّحمن البغدادي " .. أتمنى أن يفي بالغرض فائق إحتراماتي ترتيب الفورمة - ترحيل البيانات.rar

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

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

السلام عليكم اخي ياسر خليل ماقصدت الوصول اليه بهذا الشكل كي تتضح لديك الصورة اي اننا لن نصل للحد الاعلى من الهيبر لينك نستخدم الخليه الحاليه هيبرلينك ومجرد استخدامنا للخليه الحاليه نحذف السابق ارجو ان وصلت الفكره Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, ActiveSheet.UsedRange) Is Nothing Then Dim R As Hyperlink For Each R In ActiveSheet.Hyperlinks If R.TextToDisplay > "" Then R.Delete Next With ActiveSheet .Hyperlinks.Add Anchor:=Target, Address:=Target, SubAddress:="", TextToDisplay:=CStr(Target.Text) End With Set R = Nothing End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, ActiveSheet.UsedRange) Is Nothing Then Dim R As Hyperlink For Each R In ActiveSheet.Hyperlinks If R.TextToDisplay > "" Then R.Delete Next With ActiveSheet .Hyperlinks.Add Anchor:=Target, Address:=Target, SubAddress:="", TextToDisplay:=CStr(Target.Text) End With Set R = Nothing End If End Sub

أخي الكريم ناصر يبدو أنني حصلت على الكتالوج بالفعل ههههه إليك التعديل في هذا السطر ليناسب طلبك With Sh.Range("A1:D20") بدلاً من السطر With Sh.UsedRange

أخي الكريم خالد إليك الملف التالي كنموذج يمكنك التعديل عليه بما يتلائم مع ملفك تقبل تحياتي UserForm TextBox Input YasserKhalil.rar

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

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

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

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

جزاكم الله خيرا وجزيل الثواب اخ محمد عصام ويمكن اضافة العدد 1 على التاريخ او انقاصه فهو بمثابة زيادة يوم او انقاصه ! فالتعبير في مثال الاستاذ يوسف ممكن ان يكون : Me.txtDate = Me.txtDate + 1 للزيادة و -1 للانقاص تحياتي

السّلام عليكم و رحمة الله و بركاته تفضّل أخي الغالي " أبو عبد الرّحمن البغدادي " .. ربّما يكون المطلوب فائق إحتراماتي زيادة خانات الفورمة.rar

تفضل SHsabShahry.rar

اعزائي عزيزي واخي الاستاذ الخبير ابو عارف وبعد اجمل واطيب تحية اقول دائما ان التفكير منطقيا في المشكلة قبل الحل هو ذات اهمية كبيرة ! فكرت في هل طافت هذه على ميكروسوفت ! فبحثت قليلا في دوال الاكسس فوجدت الدالة التالية : formatnumber واتوقع هي لما نحتاج في التقريب ! وهنا نفذت فكرة كانت تدور في ذهني وكاتالي : Function ramhan_round(xnumber, xrounded) ramhan_round = Format(xnumber, IIf(InStr(1, xnumber, ".") > 0 And xrounded <> 0, "0.", "0") & String(xrounded, "0")) End Function =ramhan_round(125.366, 2) وباستخدام الدالة فورمات ! واخيرا يمكنكم تجربة الدوال : formatcurrency,formatdate,formatpercent لفائدة اكثر ! تحياتي

مثال رقم 3 :- فى المثال رقم 2 كان الشرح على نفس الصوره السابقه فورم فى مرحلة التصميم وصممت عليه Frame والفريم لا يوجد به اى عناصر تحكم تم تصميمها وكان المثال برقم 2 انى اعمل كود عند فتح الفورم يكون هناك عدد 10 صفوف من العناصر كل صف به ليبل وتكست بوكس وكمبوبوكس المثال بتاعنا اليومعايز اعرف ازاى اضيف عناصر تحكم اثناء فتح الفورم من شيت اكسيل وعدد الصفوف بالشيت غير معروف عددها فى زياده او نقصان شاهد الصوره هتعرف اكتر المثال بتاعنا بكل بساطه نفس الكود اللى بالمثال 2 مع تعديلات فنيه بسيطه جدا دا كان الكود اللى بالمثال 2 Private Sub UserForm_Initialize() Dim Top As Integer Dim i As Integer Top = 5 For i = 1 To 10 With Me.Frame1.Controls.Add("Forms.Combobox.1", "Combobox" & i) .Left = 20 .Top = Top .Height = 40 .Width = 150 .BackColor = &HFFFFC0 .TextAlign = fmTextAlignCenter .FontSize = 20 .Font.Bold = True Dim a As Variant a = Array("ناجح", "راسب") .List = a End With With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF End With With Me.Frame1.Controls.Add("Forms.Label.1", "Label" & i) .Left = 340 .Top = Top .Height = 40 .Width = 150 .SpecialEffect = fmSpecialEffectEtched .TextAlign = 2 .FontSize = 24 .Font.Bold = True .BackColor = 8454016 .Caption = "الصقر" & i End With Top = Top + 40 Next Me.Frame1.ScrollHeight = Top End Sub ايه المطلوب تعديله بالكود لكى يتناسب مع المطلوب بتاعنا رفع الخلايا من الشيت الى الفريم المثال كان على ان عدد الصفوف 10 لذالك استخدمنا الحلقه For next كالتالى For i = 1 To 10 فدلوقتى انا عايز اجيب الخلايا بالشيت رقم 1 النطاق من A2 الى اخر صف هيكون به اخر طالب اذن بداية الحلقه هى اول صف بالجدول وهو الخليه A2 ورقم الصف لها هو 2 اذن الحلقه هتبدأ من رقم 2 الى ؟ الى اخر صف به بيانات فى العمود A اذن لازم احدد اخر صف به بيانات من خلال السطر التالى واحنا شرحناه قبل كدا lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row عملت متغير واسمه Lr وتقدر تسميه اى اسم كيفما شئت وقلت ان المتغير Lr يساوى كتبت اسم الشيت المراد العمل عليه واستخدمت Cells لتحديد عدد الخلايا الممتلئه بالبيانات فى العمود 1 كدا انا عرفت الحلقه من اين تبدأ واين تنتهى ( تبدأ من الصف 2 الى اخر صف به بيانات ) For i = 2 To lr شاهد الكود بعد تعديل الحلقه For Private Sub UserForm_Initialize() Dim Top As Integer Dim i As Integer lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row Top = 5 For i = 2 To lr With Me.Frame1.Controls.Add("Forms.Combobox.1", "Combobox" & i) .Left = 20 .Top = Top .Height = 40 .Width = 150 .BackColor = &HFFFFC0 .TextAlign = fmTextAlignCenter .FontSize = 20 .Font.Bold = True Dim a As Variant a = Array("ناجح", "راسب") .List = a .Text = Sheet1.Cells(i, 3).Text End With With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With With Me.Frame1.Controls.Add("Forms.Label.1", "Label" & i) .Left = 340 .Top = Top .Height = 40 .Width = 150 .SpecialEffect = fmSpecialEffectEtched .TextAlign = 2 .FontSize = 24 .Font.Bold = True .BackColor = 8454016 .Caption = Sheet1.Cells(i, 1).Text End With Top = Top + 40 Next Me.Frame1.ScrollHeight = Top End Sub اللى مركز معايا هيلاقى 1- تم تعديل بداية ونهاية الحلقه For 2- فى سطر تم اضافته فى خصائص كل عنصر فى عنصر الكمبوبوكس تم اضافه السطر التالى .Text = Sheet1.Cells(i, 3).Text قيمة الكمبوبوكس هى كتبت اسم الشيت وهو بمثالنا الشيت 1 ثم الخلية المطلوبه Cells عباره عن (رقم العمود, رقم الصف)Cells ( Cells( i , 3 i هنا هى رقم الصف اللى هيتغير كل مره بالحلقه For والعمود هو رقم 3 الخاص بالحاله --------------------------------- فى عنصر التكست بوكستم اضافه السطر التالى .Text = Sheet1.Cells(i, 2).Text نفس الكمبوبوكس ولكن تم تغيير رقم العمود هو 2 الخاص بالدرجه ---------------------------------- فى عنصر الليبل تم اضافه السطر التالى .Caption = Sheet1.Cells(i, 1).Text نفس الكمبوبوكس والتكست بوكس ولكن تم تغيير رقم العمود هو 1 الخاص باسم الطالب ----------------------------------------------------------------------------------------------------------------------- ملحوظه اخيره لمن يريد درجة الاحترافيه فى الكود لما كنا بنعمل خصائص العنصر كان الخاصيه Left & Top & Width& Height لكل عنصر كان بيتم كتابتهم بالشكل التالى كلا منهم على حد فى سطر مختلف على سبيل المثال خصائص التكست بوكس With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With ممكن اكتب الاربع خصائص فى سطر واحد من خلال Move القاعدة الخاصه بــ Move Move Left, Top, Width, Height. ويكون شكل الكود كالتالى بالخصائص With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Move 180, Top, 150, 40 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With تم استبدال الاربع صفوف بسطر واحد من خلال Move -------------------------------------------------------------------------------------------------------- جرب الكود بنفسك هتثبت المعلومه اكتر الى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد ان شاء الله هيكون عن كيفية التحكم فى العناصر الموجوده داخل الفريم سوء كانت مصممه اثناء عملية التصميم او تم انشائها بكود انتظرونا تقبلوا تحياتى

اهلاً و مرحبا الاستاذ/ اباجود فعلا دالة فورمات مناسبة للحل الموضوع بعبارة اسكيو ال و استخدامها للمنزلة عشرية محددة ولكن استعمالها للمنازل عشرية مختلفة !! نحتاج تغير في الدالة عند كل تغير، و في هذالحالة من الافضل إنشاء وحدة النمطية واستعانة بأكواد vba و في نافذة vba يمكن عمل اكواد ما انا عاجز وصول اليه حتى الان. صحيح وجهة نظري هذا اسبق من موضوع الحالي، مجرد تاريخ انشاء قاعدة قديمة و السبب !!حدوث مشكلة حين تحويل قاعدة من 2010 الى 2003 ثم بحثت في الجهاز و وجدت ملف mdb ولصق كائنات جديدة بعد مسح كائناتها القديمة.. وبالتأكيد ما قمت بالنشر من صنعي ولايمكن نشر منتوج غيري ابدا الا و ذكرت اسم المصدر. تحياتي،،،

خامساً :- كيفية اضافه عناصر تحكم داخل الــ Frame مع التحكم فى الاسكرول بار وذالك عند فتح الفورم او اثناء العمل على الفورم وهو نشط العنوان يبدو انه غريب شوية ومعقد انا بس محتاج من حضرتك تشرب كوباية شاى وتفتح زهنك معايا لان ده شغل محترفين والحمد لله احنا مشينا مشوار طويل فلازم يكون عندك ثقه بنفسك وتقتحم الصعاب وميهمكش طالما انت فى جامعه اوفيسنا بص يا سيدى العنوان ده بختصار ماذا يعنى ؟ طبعا احنا عارفين ان علشان اصمم عنصر تحكم لازم يكون من شاشة التصميم لكن انت عمرك فكرة او خطر ببالك انك تخلق أو تنشئ عنصر تحكم وانت شغال على الفورم مش فى مرحلة التصميم !!!!!! طبعا انتو عارفين انى اناعملى وعلشان افهم لازم اعمل مثال عملى فبالمثال يتضح لنا المقال شوف الصوره دى وخليك معايا اوعى تغمض عنيك هو ده موضوعنا اليوم ازاى نصمم اى عنصر تحكم اثناء فتح الفورم بكود فى حدث فتح الفورم او اثناء عمل الفورم تعالو على سبيل المثال نعمل كود فى حدث فتح الفورم Initialize كدا انا عملت سطر الاعلان عن المتغير وقمت بتسميته Label ( وممكن تسميه اى اسم كيفما شئت ولكن كما قلت افضل تسميته طبقا لاسم عنصر التحكم ) وقلت ان نوع المتغير من النوع MSForms.Label وعايز احول المتغير ده الى كائن بحيث اعرفه واقدر اتعامل معاه فأستخدمت set وهذه الكلمة هى لتحويل المتغير الى كائن القاعده الخاصه بـ Set هى الكائن = المتغير set الكائن = Set Label ما هو الكائن ؟؟؟ هو عنصر تحكم هيتم اضافته على الفورم Controls.Add ( تعنى اضافه عنصر ) القاعدة العامه للـ Controls.Add هى (Controls.Add(ProgID, Name ,Visible الجزء الثالث , الجزء الثانى , الجزء الاول الجزء الاول :- ProgID يكون اجبارى الادخال وهو يكون احدى عناصر الفورم كالتالى الجزء الثانى :-Name هو اسم العنصر اللى هيتم استخدامه فى كتابة الاكواد وهو يقوم بدور الخاصيه Name فى شاشة الخصائص ويكون تعبئة اختياريا ولكن يفضل كتابتة اذا كنت تريد التعامل مع هذا العنصر فيما بعد الجزء الثالث:-Visible ويكون تعبئة اختياريا وهو يحمل خيارين أما True أو False ويفضل عدم استخدامه ليه يا عمنا ؟ لان طالما فكرت تنشأ عنصر تحكم اثناء عملك على الفورم اذا انت اكيد عايز تظهره للمستخدم مش انك هتخفية ! اذن لما نيجى نحول المتغير الى كائن لنستطيع التعامل معه هنستخدم قاعدة Set وهيكون كالتالى Set label = Controls.Add("forms.label.1", "label") هنا فى قاعدة Controls.Add قمت بتعبئة الجزء الاول ProgID وهو "forms.label.1" وتم وضعه بين علمتى تنصيص والجزء الثانى Name هو "label" وتم وضعه بين علامتى تنصيص وهو هيكون اسم العنصر فى كتابة الاكود الجزء الثالث Visible كما قلت انه اختيارى فلم اقم بتعبئته لذالك سيقوم الفيجوال بيسك باستخدام True بشكل افتراضى كدا وصلنا بالكود الى الان كالتالى Private Sub UserForm_Initialize() Dim label As MSForms.label Set label = Controls.Add("forms.label.1", "label") End Sub طيب انا كدا قمت بتصميم العنصر Label وعايز اعمل له خصائص على سبيل المثال اسم الليبل يكون " الصقر " يبعد عن الضلع الايسر للفورم بمقدار 100 عرضه يكون 120 يبعد عن الضلع الاعلى للفورم بمقدار 50 الخلفيه تكون حمراء محازة النص يكون بالمنتصف حجم الخط 20 سماكة الخط عريض التاثير يكون بارز طبعا الكلام ده شرحناه فى دروس الليبل وهيكون كالتالى فى الكود Private Sub UserForm_Initialize() Dim label As MSForms.label Set label = Controls.Add("forms.label.1", "label") With label .Caption = "ÇáÕÞÑ" .Left = 100 .Width = 120 .Top = 50 .BackColor = &HFF& .TextAlign = fmTextAlignCenter .Font = 20 .Font.Bold = True .SpecialEffect = fmSpecialEffectRaised End With End Sub شاهد الصوره عند تشغيل الفورم عايزك تجرب تنشئ عنصر تحكم او عناصر تحكم غير الليبل لازم تجرب بنفسك يا عبدالتواب ناخد مثال اخر مثلا الكمبوبوكس شاهد الكود كالتالى ولاحظ الفرق بنفسك Private Sub UserForm_Initialize() Dim Combobox As MSForms.Combobox Set Combobox = Controls.Add("forms.Combobox.1", "Combobox") With Combobox .Left = 100 .Width = 120 .Top = 50 .BackColor = &HFF& .TextAlign = fmTextAlignCenter .Font = 20 .Font.Bold = True .SpecialEffect = fmSpecialEffectRaised .RowSource = "A2:A10" End With End Sub شاهد الصوره عند فتح الفورم طبعا دى كلها مقدمه للدرس بتاعنا اللى لسه الى الان مبدأناش الشرح فيه ولكن كان لازم نعرف يعنى ايه نضيف عنصر تحكم اثناء عمل الفورم وليس من شاشة التصميم للدرس بقية انتظرونا

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

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