الـعيدروس

السلام عليكم سبق وان طرح استاذنا القدير دغيدي كود لحذف الصور في الورقة النشطه وهذا كود لحذف الصور في جميع الاوراق Option Explicit Sub delet_Pict() Application.ScreenUpdating = False Application.EnableEvents = False Dim myPict As Picture Dim s For s = 1 To Sheets.Count For Each myPict In Sheets(s).Pictures myPict.Delete Next myPict Next s End Sub والسلام عليكم

السلام عليكم استاذنا الحبيب يحياوي اسعد الله مساك الاخوة الاحبه مسائكم فل وياسمين نأتيكم مابجعبتنا كود لإخفاء القوائم تماماً هذا الكود للإخفاء ندرج قيمة FALSE Sub hid_koaeem() Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)" End Sub وفي حالة الإظهار ندرج قيمة true هكذا Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",true)" والسلام عليكم

السلام عليكم الكود في حدث الورقة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A2:A100")) Is Nothing Then VBA.Calendar = vbCalHijri ' اذا كنت تريد التاريخ هجري 'VBA.Calendar = vbCalGreg ' إذا كنت تريد التاريخ ميلادي With Target(1, 4) ' العمود الاول والعمود المراد كتابة التاريخ والوقت فيه '.NumberFormat = "[$-1010000]yyyy/mm/dd;@" ' إذا كنت تريد التاريخ ميلادي .NumberFormat = "[$-2060000]B2yyyy/mm/dd;@" ' اذا كنت تريد التاريخ هجري .Value = Date & " _ " & Time ' يظهر التاريخ مع الوقت .EntireColumn.AutoFit ' توسيع العمود بقدر كبر التاريخ والوقت End With End If End Sub

فيه فورم بحث وشغال مزبوط مالمطلوب ارجو التوضيح اكثر تفصيل والسموحه منك لصلافة فهمي

السلام عليكم تفضل كشف المجموعات2.rar

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

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

حدد في التكست الاول 2 والتكست الاخر 39 واضغط الزر إدخال الإجماليات

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

ألسلام عليكم هذا مرفقك وعليه كود الاستاذ أبو اسامة العينبوسي إحصائية شهريه 2.rar

لاتنسى أسماء الاوراق والكود لايقوم بالربط بتاتا

السلام عليكم الاستاذ القدير طارق محمود جزاك الله خير على هذا العمل مجهود كبير وفقك الله الاخ الفاضل عملت فورم وعليه 2 تكست بوكس تحديد عدد الاوراق المراد اما اضافة الاجماليات او حذفها مثلا : من ورقة رقم 2 الى ورقة رقم 10 جرب واخبرني النتيجه الارتباطات_alidroos.rar

السلام عليكم جزء النسب المئوية اطلع على المرفق كشف المجموعات1.rar

السلام عليكم اطلع على هذا الرابط ان شاء الله يكون هو طلبك http://www.officena.net/ib/index.php?showtopic=34724&hl=%2B%D8%A8%D8%B1%D9%86%D8%A7%D9%85%D8%AC+%2B%D8%AD%D8%B3%D8%A7%D8%A8%D8%A7%D8%AA&fromsearch=1

السلام عليكم هل لنا بمقتطف بسيط عن عمل البرنامج اي ماذا تريد من البرنامج ان يعمل لو تستعين بمحرك البحث للمنتدى بتلاقي العجب والعجاب وانا احاول ابحث لك تحياتي

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

السلام عليكم كيف طريقة الجمع في كل الشيتات هل هو مدى معين تريد جمعه في كل الشيتات ام لكل شيت مدى معين تريد تعمل عليه جمع

وهكذا بيكون المدى غير محدد وانما من خليه C5 الى اخر خليه فيها بيانات يقوم بنسخها الى المستودعات Sub ali_Copy() On Error Resume Next Application.ScreenUpdating = False Application.EnableEvents = False Dim Rng1 As Range Dim Tgt As Range Dim so As Range Dim LastRow As Long LastRow = Sheet2.Cells(Rows.Count, "c").End(xlUp).Row Set Rng1 = Sheet2.Range("c6:c" & LastRow) Set Tgt = Sheet17.Range("c6") Set so = Sheet16.Range("c6") Tgt.Resize(Rng1.Cells.Count).Value = Rng1.Value so.Resize(Rng1.Cells.Count).Value = Rng1.Value End Sub

السلام عليكم مجهود طيب بارك الله فيك وفي حل اخر لو انت منزل الريل بلاير في جهاز اتوماتيك تطلع لك ايقونة اعلى الفيديو Download this video لتحميل المقطع تقبل مروري

وهذا المرفق مع الزر حسب طلبك copy_c.rar

لعله هكذا رغم انك الكود كبير Sub ali_Copy() On Error Resume Next Application.ScreenUpdating = False Application.EnableEvents = False Dim Rng1 As Range Dim Tgt As Range Dim so As Range Set Rng1 = Worksheets("سعر البيع").Range("c6:c1005") Set Tgt = Sheet17.Range("c6") Set so = Sheet16.Range("c6") Tgt.Offset(0).Resize(Rng1.Cells.Count).Value = Rng1.Value so.Offset(0).Resize(Rng1.Cells.Count).Value = Rng1.Value End Sub

السلام عليكم ربما هكذا Private Sub ComboBox2_Change() On Error Resume Next x = ComboBox2.Value If x = "" Then Exit Sub TextBox13.Text = Format(TextBox13.Text, "#,##0") = Sheets(x).Range("I4").Value End Sub

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

السلام عليكم الاخ الفاضل 2012 مشكور على الهديه الاكواد الثلاثه للشكل الجمالي هي اساساً لعدة تنسيقات للفورم وانا استخدمتها لمهنه بسيطه لإخفاء اطار الفورم كشكل جمالي واذا لاتريد الترويسة تختفي احذف الاكواد الثلاثه مع الجزئيه التالية من داخل الفورم Private Sub optHideTitleBar_Click() Dim B As Boolean B = ShowTitleBar(UF:=Me, HideTitle:=True) B = IsTitleBarVisible(UF:=Me) If B = True Then Me.lblCaptionVisible.Caption = "" Else Me.lblCaptionVisible.Caption = "" End If End Sub Private Sub optEnableCloseButton_Click() Dim B As Boolean B = EnableCloseButton(UF:=Me, Disable:=False) B = IsCloseButtonEnabled(UF:=Me) If B = True Then Me.lblCloseEnabled.Caption = "Button Enabled" Else Me.lblCloseEnabled.Caption = "Button Disabled" End If End Sub وهذه لانها متصله بالاكواد التي تريد حذفها Dim B As Boolean B = IsTitleBarVisible(UF:=Me) If B = True Then Me.lblCaptionVisible.Caption = "" Else Me.lblCaptionVisible.Caption = "" End If واما فورم ثلاثة هو فورم ( Calendar تقويم) كان متصل بتكست بوكس في فورم UserForm2 نصيحه لو تريد استجابة اكثر من الاساتذه حاول ان تبدء بطلب بسيط اولا لان طرح الاضافات مرة واحده يصعب فهمها وفي الاخر تلقى اكثر تحميل ومشاهدات للملف المرفق واقل استجابه وعلى العموم القي نظرة على هذا الرابط ربما فيه احد طلباتك http://www.officena.net/ib/index.php?showtopic=39386&st=20 تحياتي

السلام عليكم بعد اذن الاستاذ القدير ابو عبدالله اكسلجي عدلت على الكود لطلبك يعمل على مدى معين فرضاً من a3:c10 هكذا Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim R_ALI As Range Set R_ALI = Intersect(Target, Range("A3:c10")) If Target.Value <> R_ALI Then Exit Sub If R_ALI > 20 Then Application.Speech.Speak "Sorry You Entered Number Greater Than 20 If You Want To Keep It Press Yes Else Press No" Choices = MsgBox(" YES " & "إذا كنت تريد الإبقاء على الإدخال الحالي إضغط " & vbNewLine & " NO " & "وإذا كنت تريد حذف الإدخال الحالي إضغط ", vbYesNoCancel, "تحديد المطلوب") Select Case Choices Case vbYes Exit Sub Case vbNo Target.Select Target = "" GoTo 1 End Select End If 1 End Sub تنبيه برسالة 1صوتية.rar