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

بسم الله الرحمن الرحيم وجدت كثيرا من الاعضاء تطلب هذا الموضوع كثيرا وعندما وضعت مثال لشاشة دخول بكلمة مرورظهر ليا مشرف كدا كالعادة وقالي البوقين دول كنت أفضل يكون في موضوع مستقل لأن المشاركات الفرعية تندثر مع الوقت لما تلاقي نفسك عملت ملف مميز زي كدا .. افتح موضوع جديد واشرح بالتفصيل (مش ترمي الملف وتجري ..) وبعد كدا في المشاركة الفرعية تضع رابط للموضوع ليستفيد أكبر عدد من الأعضاء إذ أن المتابعين للمشاركات قلة .. ولكن هناك كثر في انتظار الموضوعات الجديدة للتعلم والاستفادة .. متنساش كلامي يا سكر زيادة وانا حبيت اوجه له رسالة من هنا واقول له انا بحب الشاي سكر خفيف المهم حبيبي الغالي فعلا صدق في كلامه فا نخش في الموضوع وبلاش رغي بقي اولا نفتح بقي ملف اكسيل جديد ونخش محرر الاكواد ونعمل يوزر فورم جديد ونقوم بوضع عدد واحد ليبل عشان نتكب فيها كلمة المرور او رمز الحماية او أي حاجه في أي حاجه اثنين تكست بوكس الاول لكتابة المستخدم داخلها كلمة المرور اللي هيكتبها عند الدخول الثاني مش مهم لينا كل لزمته انه كل ما المستخدم يحط رقم غلط يزود فيه رقم لحد لما يوصل للرقم المحدد لاغلاق البرنامج وتظهر رسالة تقوله GAME OVER بمعني انه استنفذ كل المحاولات وجاري اغلاق البرنامج وواحد كومند زرار يعني عشان ندوس عليه للدخول ز ما احنا شايفين وطبعا متنسوش تحطه خلفيه حلوة كدا للفورم دا اهم حاجه عندي اه كله الا الجماليات وموضوع الجماليات دا نعمله موضوع قريب ان شاء الله بس تكون عندكو لسعه فوتوشوب بس وطبعا نخلي الخلفية علي وضع الاسترتش اه يعني الصورة تبقي لازقه في الفورم كيبر تكبر معاه يصغر تصغر معاه تمام كلنا عارفين الاسترتش كويس زي ما احنا شايفين نيجي بقي للاكواد اول كود نحطه في الجينرال بقي اول حاجه Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) 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 DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long Const GWL_STYLE = -16 Const WS_CAPTION = &HC00000 Const WS_SYSMENU = &H80000 والكود التاني في حدث تهيئة اليوزر فورم Private Sub UserForm_Initialize() Dim lngWindow As Long, lFrmHdl As Long lFrmHdl = FindWindow(vbNullString, Me.Caption) lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE) lngWindow = lngWindow And (Not WS_CAPTION) Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow) Call DrawMenuBar(lFrmHdl) End Sub toolwindowودول لزوم الفشخرة والمنظره وعشان نقصقص البتاعه دي ويضفي جمالا للفورمة هي الخيارات بتاعتها متاحه في الفيجوال بيسك عادي زي كدا ننفض للحته دي نخش علي الكود اثالث ودا هيبقي في تنشيط اليوزر فورم Private Sub UserForm_Activate() Application.WindowState = xlMaximized With Me .Height = Application.Height .Width = Application.Width .Left = Application.Left .Top = Application.Top End With End Sub ايه الكلام دا دا ياسيدي بنقوله كبر لنا البرنامج ملئ الشاشة Maximized لما تفتح اليوزر فورم زي الشاطر خلي مقاسات اليوزر فورم زي مقاسات البرنامج واحنا مكبرين شاشة البرنامج يبقي كدا اليوزر فورم هيبقى كبير زي البرنامج تمام كدا الكود الرابع Private Sub CommandButton1_Click() If TextBox1.Text = "123" Then Me.Hide Else am = am + 1 MsgBox " لقد استخدمت " & am & " محاولة من اصل 5 محاولات, vbCritical, "elmalak_elhazen_yasser@yahoo.com" If am = 5 Then MsgBox "لقد استنفذت جميع المحاولات" ActiveWorkbook.Save ActiveWorkbook.Close End If End If End Sub اكيد دماغكو لفت معايا معلش انا شرحي علي قده استحملوني دا كود بيقول اذا كانت التكست بوكس واحد بتساوي 123 اذن ياعم اخفيني من وشك ويظهر معاك ملف الاكسيل عادي طيب اذا ما حصلشي بقي نعمل ايه تعالا بقي am دي اسم التكست بوكس اتنين بس انا غيرته الى am ندوس علي التكست بوكس اتنين ونغيره من هنا ومننساش نخفى التكست بوكس دا من هنا واحد فكيك بقي يقول ليه am اقوله ياناصح دول اول حرف من اسيل واول حرف من محمد ولادي تمام يامعلم محدش يشتم ولا يضرب المهم بقي ان am بتساوي نفسها + 1 تمام اه قبل ما انسى نخلي قيمة am دي بصفر نكتب جواها صفر عشان لما يعد يعد من بعد الصفر يعني كل ما المعلم يدوس غلط يزود رقم واحد وتطلع رسالة تقوله وصلت لكام محاولة ولما يوصل للمحاولة الخامسة يقوله بالسلامة ياحبي انا هقفل وانام وتمام كدا زي الفل والكلام خدنا والدرس خلص شفتوا انتو مش مصحصحين ازاي نسينا نحط كود فتح الفورم في حدث فتح الملف Private Sub Workbook_Open() UserForm1.Show End Sub وبعدين انا مش هحط امثلة زي واحد صاحبي وحبيبي بيقول انكم لازم تتعبوا شوية وتعملوها بنفسكوا بدل ما تخدو كوبي وبست وخلاص للحديث بقية باذن الله لاستكمال اضافات تانيه اتمنى من الله ان ينفعكم هذا الشرح تقبلو تحياتي ياسر العربي قلت اضيف صورة الكود لكمعشان ميبقاش ليكو حجه

السلام عليكم اضن الكثير منا يعلم ماهي الوظائف الإضافيه في الاكسل ومدى اهميتها في اختصار الكثير من الوقت للعمل على روتين معين لأكثر من مصنف انا سأطرح لكم الفكرة والتطبيق والاليه التي استخدمت بها تلك الوظيفه الإضافية أولاً ماهي الوظائف الإضافيه ؟ كخطوة اولى: توضيح وحفظ الوظيفه - هيا عباره عن ملف اكسل به اكواد او فورم او داله ويحفظ بصيغة "Excel Add-In" في المسار "AppData\Roaming\Microsoft\AddIns" او في اي مجلد تريد يكون موقع له فرضاً سميناها "Aosamh" وعند الحاجه لتلك الوظيفه تقوم بتفعيل الوظيفه كي تستخدمها للملف الذي تعمل عليه الخطوة الثانية: تفعيل الوظيفه ( بعد ان حفظتها بالخطوة الاولى ) -من خيارات الاكسل - الوظائف الإضافية - إدارة الوظائف الإظافيه Excel ( تضغط زر المسمى "إنتقال" ) ومن ثم تحفز الوظيفه . الفكرة كالتالي : تقرير مخزون عبر برنامج محاسبي اصدره الى الاكسل واقوم بعمل بعض التنسيقات والتعديلات عليه بشكل اتوماتيك واستخرج منه اعمدة معينه للعمل عليها غرضي من هذه الطريقة عمل " تقرير لأصناف معينه لعمل خصم عليها بطريقة يدويه" خصم يدخل يدوي ومن ثم اجمالي الفارق بين سعر التكلفه القديم وسعر التكلفه الجديد واجمالي الفارق لكل الاصناف في نهاية التقرير ماتطلب علي استخدامة لأنجز تلك الفكره : 1- تصدير التقرير من البرنامج المحاسبي 2- معرفة بعض الكلمات الاساسيه في التقرير المستخرج من البرنامج المحاسبي ( لمعرفة ان الملف هو مانريده كي نفعل عليه الوظيفة الاضافية) 3- عمل بعض التعديلات على الملف من الغاء دمج بعض الخلايا وحذف بعض الاعمدة التي لااستخدمها للغرض الذي اريده وماسبق ذكرة الـ 3 البنود منها عملتها بظريقه يدوية ومن ثم بالكود كي يقوم بما عملته عند استدعائي للوظيفة ( 2 و 3 ) 4- عمل في بعض الاعمدة معادلات عبر الكود ومنها اجمالي التقرير بعد اضافة القيم اليدويه 5- انشاء فورم بحث للبحث عن الاصناف في التقرير سواء برقم الصنف او مرجعه الاكواد المستخدمة في ملف الوظيفة الإضافية كالتالي : 1- كود حدث فتح ملف الاكسل "Auto_Open" -استخدمناه لكي نفعل كود التحقق من ان الملف المفتوح حالياً هو مانريده "تقرير المخزون" ام لا الكود في حدث فتح المصنف بعد 3 ثواني من فتح المصنف ينفذ الكود المسمى "Action_Abad" Sub Auto_Open() Application.OnTime Now + TimeValue("00:00:03"), "Action_Abad" End Sub هذا كود "Action_Abad" يقوم بتنفيذ الدالة "Check_Work" واذا كان نتيجة الدالة True يعني هو الملف المطلوب دالة "Check_Work" تقوم بالبحث في المصنف هل يوجد كلمة "تقييم المخزون" اذا تحقق الشرط تقوم بالتالي Public Const Trgt As String = "تقييم المخزون" Public Function Check_Work() Dim Rng_Chk For Each Rng_Chk In ActiveWorkbook.ActiveSheet.UsedRange.Cells If Trim(Rng_Chk) Like Trgt Then Bl_Open = True Exit Function End If Next End Function تقوم بإنشاء زر اختصار للكود "Ali_Tk" في تبويب الوظائف الاضافية Sub Action_Abad() '=============== Check_Work '' دالة التحقق من الملف المفتوح حالياً '=============== If Bl_Open = True Then Dim cb As CommandBar Dim ctrl As CommandBarControl On Error Resume Next Application.CommandBars("Tol_Abad").Delete On Error GoTo 0 Set cb = Application.CommandBars.Add(Name:="Tol_Abad") With cb .Visible = True .Position = msoBarTop Set ctrl = .Controls.Add(Type:=msoControlButton) With ctrl .BeginGroup = True .Style = msoButtonIconAndCaption .Caption = "تقرير_خصم" .FaceId = 107 .OnAction = "Ali_Tk" '' الزر يقوم بتشغيل كود عمل التنسيقات وحذف اعمدة من تقرير المخزون .TooltipText = "تقرير خصم لأصناف" End With End With Bl_Open = False End If End Sub وهذا كود "Ali_Tk" الذي يقوم بعمل تنسيقات للتقرير واضافة اعمدة ودوال واستخراج الاعمدة الاساسية في مصفوفة "Arr" Sub Ali_Tk() Dim Arr Dim RR, Mord, On_Rw Dim Rm As Range Dim Rnn As Range, Rmm As Range Dim Rng As Range A_Application False ActiveWorkbook.ActiveSheet.UsedRange.UnMerge Arr = Array("تقييم المخزون", "‏المورد :‏", "‏م‏", "‏رقم الصنف‏", "‏وصف الصنف‏", "‏رقم المرجع‏", "‏إجمالي الكمية‏", "‏السعر‏") For Each RR In ActiveWorkbook.ActiveSheet.UsedRange.Cells For Each Ar In Arr If Trim(RR) Like Trim(Ar) Then Select Case Trim(RR) Case Is = Arr(0) Case Is = Arr(1) RR.Select Lrm = Selection.End(xlToLeft).Column '' إيجاد عمود اسم المورد Mord = CStr(S_Nm_Ali(Cells(RR.Row, Lrm))) '' إســم المورد On_Rw = RR.Row '' أول صف للجدول Case Else If Not RR Is Nothing Then If Rm Is Nothing Then Set Rm = RR Else Set Rm = Union(Rm, RR) End If End If End Select End If Next Next Rm.EntireColumn.Hidden = True Set Rng = Range("A1:AB1") '************************************************************* Rng.SpecialCells(xlCellTypeVisible).EntireColumn.Delete Range("A1:A" & On_Rw).EntireRow.Delete ActiveSheet.UsedRange.EntireColumn.Hidden = False '************************************************************* Range("A:A,B:B").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove '************************************************************* Rows("1:1").RowHeight = 40 Rows("2:2").RowHeight = 28.5 Range("C2") = "تكلفة جديدة" Range("A2") = "الفرق" ActiveSheet.UsedRange.EntireColumn.AutoFit Columns("F:F").ColumnWidth = 11 Columns("E:E").ColumnWidth = 9.14 Columns("G:G").ColumnWidth = 7.57 Columns("G:G").ColumnWidth = 11.57 Columns("G:G").ColumnWidth = 10.71 R = 3 Lr = Cells(Rows.Count, 2).End(xlUp).Row For i = R To Lr Cells(i, 1).Formula = "=IF(RC[2]="""","""",CEILING(IF(RC[2]="""","""",(RC[3]*RC[1])-(RC[3]*RC[2])),1))" Next With Range("A" & Lr + 1) .Formula = "=SUBTOTAL(9," & Range("A3:A" & Lr).Address(0, 0) & ")" .Offset(0, 1).Formula = "=SUBTOTAL(9," & Range("B3:B" & Lr).Address(0, 0) & ")" .Offset(0, 2).Formula = "=SUBTOTAL(9," & Range("C3:C" & Lr).Address(0, 0) & ")" .Offset(0, 3).Formula = "=SUBTOTAL(9," & Range("D3:D" & Lr).Address(0, 0) & ")" End With Range(Cells(3, 1), Cells(Lr + 1, 8)).Borders.Color = 1 Range(Cells(3, 1), Cells(Lr + 1, 8)).RowHeight = 24.75 Range(Cells(3, 1), Cells(Lr + 1, 8)).WrapText = False Columns("A:H").AutoFit Columns("A:D").ColumnWidth = 9 With Range(Cells(3, 1), Cells(Lr + 1, 8)) .HorizontalAlignment = xlRight .VerticalAlignment = xlCenter .Interior.ColorIndex = xlNone With Range("A" & Lr + 1 & ":H" & Lr + 1) .Interior.Color = RGB(252, 228, 214) .Font.ColorIndex = 23 .Font.Bold = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With With Range("A2:H2") .Interior.Color = RGB(252, 228, 214) .Offset(-1, 0).Merge .Offset(-1, 0).RowHeight = 40 .Font.ColorIndex = 23 .Font.Bold = True .Borders.Color = 0 .HorizontalAlignment = xlCenter .VerticalAlignment = xlTop End With End With With ActiveSheet.PageSetup .PrintArea = Range(Cells(1, 1), Cells(Lr + 1, 8)).Address .PrintTitleRows = "$1:$2" .PrintTitleColumns = "" .Zoom = 123 .LeftMargin = Application.InchesToPoints(3.93700787401575E-02) .RightMargin = Application.InchesToPoints(3.93700787401575E-02) .TopMargin = Application.InchesToPoints(3.93700787401575E-02) .BottomMargin = Application.InchesToPoints(3.93700787401575E-02) .HeaderMargin = Application.InchesToPoints(3.93700787401575E-02) .FooterMargin = Application.InchesToPoints(3.93700787401575E-02) .CenterHorizontally = True .CenterVertically = False End With Range("A3").Select ActiveWindow.FreezePanes = True ActiveWindow.SmallScroll Down:=12 Range("C3").Select With Range("A1") .Value = "(" & " طلب خصم بضاعة / " & Mord & " / للمؤسسة " & ")" .Font.Name = "Times New Roman" .Font.Size = 14 .Font.Bold = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With '===================== Action_Search '' إستدعاء كود إضافة زر اخر في تبويب الوظائف الإضافية _ لإنشاء زر في تبويب الوظائف الإضافية واسمه بحث ليقوم بتنفيذ كود فتح فورم البحث والتعديل '===================== A_Application True End Sub وفي نهاية الكود يستدعي الكود "Action_Search" ليضيف زر اخر في تبويب الوظائف الإضافية واسمه "بحث" لينفذ كود فتح " فورم البحث" Private Sub Action_Search() Dim cb As CommandBar Dim ctrl1 As CommandBarControl Set cb = Application.CommandBars("Tol_Abad") With cb .Position = msoBarTop Set ctrl1 = .Controls.Add(Type:=msoControlButton) With ctrl1 .BeginGroup = True .Style = msoButtonIconAndCaption .Caption = "بحث" .FaceId = 1100 .OnAction = "Show_Ali" .TooltipText = " بحث في بيانات الاصناف للمورد" End With End With '====================== Visbl_Control False '' الذي يقوم بعمل تنسيقات تلافياً لعدم الضغط عليه مره اخرى ' إخفاء زر المسمى تقرير_خصم '============== Action_Prnt '' إستدعاء كود لإضافة زر اخر بإسم طباعه لينفذ كود طباعة التقرير بعد الانتهاء من عمل التعديلات عليه '============= End Sub دالة " Visbl_Control" لتقوم بإخفاء زر " تقرير_خصم " تلافياً لعدم الضغط عليه مره اخرى Function Visbl_Control(Vis As Boolean) Application.CommandBars("Tol_Abad").Controls("تقرير_خصم").Visible = Vis End Function كود فتح فورم البحث المسمى " Show_Ali" Sub Show_Ali() Ali_Search.show 0 End Sub وفي نهاية كود "Action_Search" يستدعي كود المسمى "Action_Prnt" ليقوم بإنشاء زر واسمه "طباعه" لينفذ الكود المسمى "Prnt" Private Sub Action_Prnt() Dim cb As CommandBar Dim C As CommandBarControl Set cb = Application.CommandBars("Tol_Abad") With cb .Position = msoBarTop Set C = .Controls.Add(Type:=msoControlButton) With C .BeginGroup = True .Style = msoButtonIconAndCaption .Caption = "طباعه" .FaceId = 180 .OnAction = "Prnt" .TooltipText = " طباعة النتائج " End With End With End Sub وهذا كود الطباعه المسمى " Prnt" ليطبع التقرير بعد عمل التصفية للصفوف الملونه بلون معين Sub Prnt() With ActiveSheet .Range("A2:H2").Select Selection.AutoFilter Ln = .Cells(.Rows.Count, 2).End(xlUp).Row .Range(Cells(2, 1), Cells(Ln, 8)).AutoFilter Field:=6, Criteria1:=RGB(225, 225, 235), Operator:=xlFilterCellColor If .UsedRange.SpecialCells(xlCellTypeVisible).Count <= 24 Then MsgBox "لايوجد نتائج للطباعه", vbInformation, "" .Range("A2:H2").Select Selection.AutoFilter Exit Sub End If .Range("G2").EntireColumn.Hidden = True .PrintPreview .Range("G2").EntireColumn.Hidden = False .Range("A2:H2").Select Selection.AutoFilter .Range("A2").Select End With End Sub وهذا كود حدث اغلاق المصنف " Auto_close "ليقوم بحذف تبويب الوظائف الإضافية بما فيه من ازرار انشأناها وقت الاستخدام Sub Auto_close() On Error Resume Next Application.CommandBars("Tol_Abad").Delete Application.CommandBars("Benefits Survey Toolbar").Delete On Error GoTo 0 End Sub ماأرجوه من طرحي هذا اخذ فكره عن الوظائف الإضافية وبما يمكنها من استخدام اكواد ومعادلات مستحدثه في اكثر من ملف وقت الاستخدام وافكار ان شاء الله يستفاد منها - مرفق ملف شرح فيديو طريقة العمل - وملف التقرير المستخرج من البرنامج المحاسبي - وملف الاكواد والفورم وهو كوظيفة إضافية لم استطيع ارفاق الملفات حملتها عبر 4Share وهذا رابط المرفقات http://www.4shared.com/rar/x33ci575ba/_online.html والسلام عليكم

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

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

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

اخى الحبيب أ / سليم سلمت يمينك

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

السلام عليكم شكرأ للأخوين الكريمين على جهودكما ...

كبير من يومك يا كبير خلى بالك من التاتش تقبل تحياتى

يا حى يا قيوم برحمتك أستغيث اصلح لى شأنى كله ولا تكلنى الى نفسى طرفة عين

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

اخى الحبيب يوجد الكثير والكثير بالمنتدى عن شروحات لتعلم Vba على سبيل المثال وليس الحصر الروابط التالية http://www.officena.net/ib/topic/56000-دروس-فى-vba-excel-_-نتعلم-معا-برمجه-اكسل/?do=findComment&comment=354343 للأخ الغالي محمود الشريف --------------------------------------------------------------------------------------------------------- http://www.officena.net/ib/topic/56941-افتح-الباب-وادخل-لعالم-البرمجة-متخافوش-يا-أحباب-من-اللي-ورا-الباب/?do=findComment&comment=361264 للأخ الحبيب ياسر خليل --------------------------------------------------------------------------------- تقبل تحياتى

لا حول ولا قوّة إلاّ بالله

السلام عليكم ورحمة الله وبركاته... جرح غائر في صدر الإنسانية وندبة على جبين العرب لا يزول أثرها إلا بزوال البغاة على الأرض..

أخي الكريم محمد يرجى تغيير اسم الظهور للغة العربية إليك الملف المرفق فيه تطبيق الكود .. Convert Text To Numbers YK.rar

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

تسلملي حبيبي علي مرورك السكر دا واشتم ياعم الشتيمة مش بتلصق

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

أستاذى ومعلمى القدير الحبيب الغالى / ياسر خليل لا تعلم مقدار سعادتى أنا أيضا بتشريفك لى وتهنئتك لى فأنا تلميذ أتعلم وأغوص داخل بحر هذا الصرح العلمى الكبير تقبل منى خالص تحياتى وتقديرى لشخصكم الكريم

أخى وصديقى الغالى والحبيب أ / سليم حاصبيا سعدت وشرفت بمروك وتهنئتك لى فما أنا إلى تلميذ فى هذا الصرح العلمى الكبير تقبل منى خالص تحياتى وتقديرى

تم التعديل جسب الطلب protect_non_empty.zip

أستاذ خالد الرشيدى جزاك الله خيرا على كل ما تقدمه من حلول رائعة جعله الله فى ميزان حسناتك

لم اجد اجمل من كلمات اخونا محمد سلامة كفينا .. وعوفينا

جرب الكود التالي Public Sub A_Add() Dim Sh As Worksheet, Sht As Worksheet Set Sht = Sheets("Sheet2") Set Sh = Sheets("Sheet1") i = 1 Lr = Sh.Cells(Rows.Count, 1).End(xlUp).Row For Each R In Sh.Range("A1:J" & Lr).Rows A = Join(Application.Index(R.Value, 0), ",") B = Replace(A, "ES", "MR") B = Mid(B, 1, InStr(1, B, Split(B, ",")(3)) - 1) & Adm("0.00,", 3) & Split(B, ",")(7) & "." & String(2, "0") & Adm(",0.00", 2) A = A & String(3, "0") ii = Sht.Cells(Rows.Count, 1).End(xlUp).Row + 1 Sht.Cells(ii, 1) = Choose(1, A, B) Sht.Cells(ii + 1, 1) = Choose(2, A, B) i = i + 1: ii = ii + 1 Next End Sub Private Function Adm(Strn$, Ln&) Adm = Application.Rept(Strn, Ln) End Function

السلام عليكم درس ممتع ومفيد جزاكم الله خيراً..

مشكور استاذي لمروركم العطر هذا

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

جزيت خير - شرح وافي

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

وعليكم السلام المشكلة عندك في الشرط في الاستعلام klm . فالشرط يأخذ قيمته من الحقل mol في النموذج moaa ، فالنموذج moaa عندما يكون مفتوحا مباشرة ، فالاستعلام يعمل ، ولكن عندما يكون : . النموذج moaa داخل النموذج mm ، فهنا تحدث المشكلة ، فالشرط في الاستعلام في هذه الحالة يجب ان يتغير الى Forms!mm!moaa!mol (هاي ماحسبنا لها حساب ) لذلك ، واذا اردنا التقرير يُفتح من كل النماذج ، فطريقتي هي: 1. نحذف الشرط من الاستعلام: . 2. عملت زر جديد في النموذج: . وكود فتح التقرير هو: Private Sub cmd_Print_Preview_entema_Click() If Len(Me.mol & "") = 0 Then MsgBox "Please Select a name first" Exit Sub Else DoCmd.OpenReport "entema", acViewPreview, , "[name]='" & Me.mol & "'" End If End Sub جعفر 255.saa.accdb.zip

جزيت خيرا - احسنت - احسنت - احسنت - احسن الله لكم - بارك الله في عمرك ووقتك - اشكرك - ممتاز

وعليكم السلام الافصل ان تعمل جدول جديد ، تضع فيه حقلين: الاسم ، والقيمة للقسمة ، ثم في الاستعلام تربط الجدولين بواسطة حقل الاسم ، هكذا: الجدول: . الاستعلام: . والنتيجة: جعفر 254.Test.accdb.zip

ارجو عدم تكرار المواضيع انت مكرر الموضوع فوق ال6 مرات

انسخ هذا الكود الى حدث الصفحة Private Sub Worksheet_Change(ByVal Target As Range) With ActiveSheet .Unprotect .Cells.Locked = True .Cells.SpecialCells(xlCellTypeBlanks).Locked = False .Protect End With End Sub

السلام عليكم لم يكن من المقصود حدوث ذلك سيتم بحث الأمر باذن الله يرجى عمل ريفريش CTR+F5 و التجربة مرة اخري الان

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

السلام عليكم ورحمة الله هذا حل آخر بمعادلة طويلة بعض الشيء ولكنها تعتمد التكرارات مهما كان عددها.... بن علية مرفق 1 hben.rar

هذا ملفك وبه الكود بعد كتابة القيد انقر زر ترحيل القيد يومية الأمريكية.rar

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

الله عليك يا أ / ياسر كود أكثر من رائع أخى الحبيب تسلم يمينك ومرفق أيضا المرفق الأول للحل بدون كماية VBA بعد إذنك يا أ / ياسر فرز المكرر بإجمالى مبيعاته مرتب أبجديا.rar

أخي الكريم نور وحيد جرب الكود التالي عله يفي بالغرض Sub Summary() Dim I As Long, J As Long, M As Long, N As Long, LR As Long, V, ZUM Dim C As Collection Set C = New Collection Application.ScreenUpdating = False On Error Resume Next For I = 3 To Rows.Count V = Cells(I, 1).Value If V = "" Then N = I - 1 Exit For End If C.Add V, CStr(V) Next I On Error GoTo 0 M = 3 For I = 1 To C.Count Cells(M, 5) = C.Item(I) ZUM = 0 For J = 3 To N If Cells(J, 1).Value = Cells(M, 5).Value Then ZUM = ZUM + Cells(J, 2).Value End If Next J Cells(M, 6).Value = ZUM M = M + 1 Next I LR = Range("E" & Rows.Count).End(xlUp).Row Range("E3:F" & LR).Sort Key1:=Range("E1:E" & LR), Order1:=xlAscending, Header:=xlNo Application.ScreenUpdating = True End Sub وإليك الملف المرفق الخاص بك Unique Items With SUM & Sort YasserKhalil.rar

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

أخي الكريم ارفق الملف المراد العمل عليه .. جرب الكود التالي عله يفي بالغرض Sub ConvertTextToNumber() Dim R As Range On Error Resume Next For Each R In Sheet1.UsedRange.SpecialCells(xlCellTypeConstants) If IsNumeric(R) Then R.Value = Val(R.Value) Next R End Sub

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

الله يبارك فيك ويجزيك خيرًا أسأل الله أن يجعل هذا العمل في ميزان حسناتك خالصًا لوجهه

شكرا أخي على المعلومة.

حركة جميلة ومفيدة شكرا عاشت ايدك

بسم الله الرحمن الرحيم الاخ halwim الروابط تعمل وقمت بحقظهم لك فى المرفقات Excel.rar تحياتى

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