الـعيدروس

غير الى اي جزء من الدقيقة او الثانيه بمعنى 1= ثانيه و 0.5 نصف ثانية يعمل معك إن شاء الله

السلام عليكم بعد اذن استاذي الحبيب عبدالله المجرب الكود التالي ربما يفيد الأخ السائل '***************************************** ' ' - ' نطـاق النصوص التي تحتوي على العلامة ' '***************************************** Private Const Act As String = "$A$2:$G$50" Public Sub Ali_Rep() For Each R In Range(Act) R.Value = Replace(R.Text, "-", " ", , , vbTextCompare) Next End Sub

السلام عليكم بالامكان الاستعانه بهذا الكود يقوم بحفظ الملف كل دقيقة هذه الأكواد في مودويل Public Rm As Double Public Const C_Con = 60 Public Const Sc_W = "Ex" Public Sub St_A() Rm = Now + TimeSerial(0, 0, C_Con) Application.OnTime EarliestTime:=Rm, Procedure:=Sc_W, Schedule:=True End Sub Sub Ex() Application.DisplayAlerts = False ThisWorkbook.Save Application.DisplayAlerts = True St_A End Sub وهذه في حدث Thisworkbook Private Sub Workbook_Deactivate() Call St_A End Sub Private Sub Workbook_Open() Call St_A End Sub

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

السلام عليكم جرب الكود التالي عمل الكود مزدوج تفعيل تعطيل Public Sub A_Show() Dim Cm As CommandBar For Each Cm In Application.CommandBars Cm.Enabled = Not Cm.Enabled Next End Sub

السلام عليكم اخي الفاضل foular لو جزئت طلباتك حبه حبه لكي نستوعبها كان افضل من طرحها مره واحده تحياتي

اخي goodlife اضن انه سيعمل معك جرب الكود ارجو ان يزبط معك حط الكود التالي في حدث الـ ThisWorkbook Private Sub Workbook_SheetCalculate(ByVal Sh As Object) Application.DisplayAlerts = False Application.EnableEvents = False On Error Resume Next Call Ali_Formola Application.EnableEvents = True Application.DisplayAlerts = True End Sub

اخي الشيباني1 بعد تنفيذ الكود شغل الماكرو المسمى " Ali_Formola " كم الشرح في الماشركة الاولى

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

السلام عليكم أخوتي الاحبه حفظكم الله هذا طلب تكرر كثيرا من بعض الأعضاء وهذه محاولتي في السطر الأول من الكود تحدد المدى الذي فيه المعادلات في كل الأوراق كمثال وتغيره مثل ماتريد '********************************************* ' مدى المعادلات في كل الأوراق '********************************************* Private Const Rng As String = "$A$2:$Z$500" وهذه الأكواد انسخها في مودويل '********************************************* ' مدى المعادلات في كل الأوراق '********************************************* Private Const Rng As String = "$A$2:$Z$500" Private Sub Ali_M() Set V_A = ActiveWorkbook.VBProject Set V_b = V_A.VBComponents.Add(vbext_ct_StdModule) V_b.Name = "My_Frmola" End Sub Private Sub Ali_Delet() On Error Resume Next Dim V_A Dim V_b Set V_A = ActiveWorkbook.VBProject Set V_b = V_A.VBComponents("My_Frmola") ActiveWorkbook.VBProject.VBComponents.Remove V_b End Sub Public Sub Ali_Fmla_To_VBA() Dim Sht As Worksheet Dim R As Range, Rr As Range Dim Ar_Ads(), Ar_Fm() Dim F, Lc, Prmit_A, Rw Call Ad_Refe: Call Ali_Delet: Call Ali_M Dim A Dim B Dim C Set A = ThisWorkbook.VBProject Set C = A.VBComponents.Item("My_Frmola").CodeModule On Error Resume Next For Each Sht In ThisWorkbook.Worksheets For Each Rr In Sht.Range(Rng).SpecialCells(xlCellTypeFormulas) If Not IsEmpty(Rr) Then ReDim Preserve Ar_Ads(0 To F) ReDim Preserve Ar_Fm(0 To Lc) Ar_Ads(Lc) = "Sheets(""" & Rr.Worksheet.Name & """)" & "." & "Range(""" & Rr.Address(0, 0) & """)" Ar_Fm(F) = "=" & "Evaluate(""" & Rr.FormulaLocal & """)" F = F + 1: Lc = Lc + 1 End If Next Next With C .AddFromString ("Sub Ali_Formola" & vbCrLf) For Prmit_A = LBound(Ar_Ads) To UBound(Ar_Ads) N = .CountOfLines .InsertLines N, Ar_Ads(Prmit_A) & Ar_Fm(Prmit_A) N = N + 1 Next .InsertLines N + 1, vbCrLf & "End Sub" End With Erase Ar_Ads: Erase Ar_Fm End Sub Private Sub Ad_Refe() On Error Resume Next With ThisWorkbook.VBProject.References .AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL" .AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB" .AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL" .AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB" End With End Sub بعد النسخ الى مودويل " Alt " + F8 تشغيل الكود المسمى " Ali_Fmla_To_VBA " بعد استخدام الكود كما ذكرت اذا اردت تحويل المعادلات في جميع الأوراق الى أكواد فعل الماكرو المسمى " Ali_Formola " أرجو تجربة الكود الكود يعتبر بدائي ولاكن يمكن تطويره فيما بعد تحويل المعادلات الى اكواد.rar

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

السلام عليكم شاهد المرفق الخلايا الصفراء وجرب نفذ الكود من الزر A_Cr.rar

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

السلام عليكم Public Sub A_Cr() ' مدى1 مدى2 مدى3 مدى4 مدى5 Union([H12:H27], [J12:J27], [A7], [B7], [L7]).ClearContents End Sub أرجو من الأخوة المشرفين تعديل عنوان المشاركة

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

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

السلام عليكم اخي رجب جاويش الف الف مبروك على الترقيه رغم تأخرها ترقيه مستحقه بارك الله تقبل مروري

السلام عليكم ارجو ان يفي بالغرض مساعدة في تعديل وحذف وتحديث في اللست بوكس_A.rar

السلام عليكم Dim r As Range, rc As Range, Rn As Range Dim Sn As Worksheet Dim Rw On Error Resume Next Set Sn = Sheets("إسم الورقة هنا") Set r = Sn.Range("A2:AF1000") For Each rc In r If Sn.Cells(rc.Row, 1) = Val(TextBox1) Then Set Rn = Sn.Range(Sn.Cells(rc.Row, 3), Sn.Cells(rc.Row, rc.Column)) End If Next For c = 1 To Rn.Columns.Count If Rn.Cells(1, c).Value <> "" Then With Me.ComboBox1 .AddItem Rn.Cells(1, c).Value End With End If Next Set r = Nothing: rc = Nothing: Rn = Nothing

السلام عليكم RC[-2] تشير الى مرجع الخلية النشطه R تمثل الصف و C العمود ناقص 2 اي اذا الخليه النشطه هيا C1 تعتبر بالمرجع السابق هيا A1

الحمد لله

هل الموردين ثابتين ام بيزيدو بإستمرار لاني ملاحظ في ملفك الاساسي الموردين والمستودعات في عمود مع بعض ضننت انهم ثابتين اذا هم غير ثابتين نفصل المستودعات في عمود والموردين في عمود اخر ؟ تم تعديل كود التفقيط للعمله التي تريدها في المرفق Kh_Purchase-Order_2.rar

السلام عليكم كيف يكون التوزيع ؟؟؟ وماهي اللجان هل هي " ف1 " و " ف2 " ارجو شرح طلبك بالتفصيل الممل لاني ليس لي درايه في هذه الأعمال = " يعني تقدر تقول صندوق مقفل بالبرامج المدرسية " ولكن إن وضح الطلب سوف أحاول اعمل كود يلبي الطلب تحياتي

السلام عليكم ككل اعمالك اخي ابو حنين جميل جميل جميل جداً الاحلى في اعمالك بساطتها والأفكار تحف نادره بارك الله فيك وجعل اعمالك في موازين حسناتك تقبل مروري

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