الـعيدروس

السلام عليكم الصق الكود التالي في مودويل Sub Auto_open() ' غير الزر المراد استخدامه للحفظ بين القوسين ' F2 , F1 , F3 وهكذا Application.OnKey "{F2}", "Sv" End Sub Sub Sv() ThisWorkbook.Save End Sub

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

الاخ الفاضل احمد فؤاد عمل متقن وجميل وبه مجهود كبير جزاك الله خيرا وبارك فيك تقبل مروري

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

استاذي الحبيب طارق محمود السطر الثالث الاصح يصفر في حال تساوى الدائن والمدين وحساب أصول ثابتة من ح اصول ثابته => الى ح اهلاك أصول ثابته والله اعلم

اخي الكريم الرجاء ارفاق مثال وبه النتيجه المطلوبه

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

غير المحاذه العمودي الى ( اسفل ) وليس توسيط

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

تعديل بسيط على الكود Scn_1.rar

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

ارى ملفك مكتمل اين المشكله ؟

السلام عليكم جرب الكود التالي Private Sub TextBox1_Change() Dim Rw As Long Dim Ctr If Me.TextBox1 = "" Then Lis_Rn Ctr = "*" & Me.TextBox1 & "*" With Me.ListBox1 For Rw = .ListCount - 1 To 0 Step -1 If Not .List(Rw, 0) Like Ctr Then .RemoveItem Rw End If Next Rw End With End Sub Private Sub UserForm_activate() Lis_Rn End Sub Private Sub Lis_Rn() With Sheets("ورقة1") ListBox1.List = .Range("A1:C" & .Range("A" & .Rows.Count).End(xlUp).Row).Value End With End Sub Book1_A.rar

الكود المشار اليه الصقه في حدث Thisworkbook وجرب راح يعمل معك في كافة اوراق المصنف

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

السلام عليكم بعد اذن الاستاذ القدير بن عليه اضن المراد اختيار الملف وفتحه بيكون التعديل على كود زر Open MRR كالتالي Private Sub cmdClear_Click() Dim File As String, Emplacement As String Dim Pd_a On Error Resume Next 'Emplacement = "C:\Test\" 'File = Emplacement & Split(txtICn.Value, "/")(2) & "_" & Split(txtICn.Value, "/")(3) & ".pdf" Pd_a = Application.GetOpenFilename("pdf Files (*.pdf), *.pdf,,,") If Dir(Fichier) <> "" Then ShellExecute 0, "open", Pd_a, "", "", 0 End Sub

السلام عليكم بعد اذن استاذنا الكبير عبدالله باقشير هذا تعديل بسيط لكود حدث الورقة Private Sub Worksheet_Change(ByVal Target As Range) Columns("A:az").AutoFit Dim rng As Range Set Fn = Application.WorksheetFunction Set rng = Range([a1], [a1].End(xlToRight)) CountCol = rng.Columns.Count DelAllNames For x = 1 To CountCol EndRow = Cells(Rows.Count, x).End(xlUp).Row If EndRow = 1 Then EndRow = EndRow + 1 On Error Resume Next Range(rng(x).Offset(1), Cells(EndRow, x)).Name = Fn.Substitute(rng(x), " ", "_") Next If Not Intersect(Target, [A2:A1500]) Is Nothing Then For Each Cn In Target Set Rn = Sheet2.[E6] Rn.ClearNotes Rn.AddComment Ci = Application.CountA(Columns(Target.Column)) - 1 Tn = "" If Ci > 0 Then For Each C In Cells(2, 1).Resize(Ci) Tn = Tn & C & IIf(Rw = 2, "", "+") & IIf(Rw = 2, Chr(10), "") If Rw = 3 Then Rw = 1 Rw = Rw + 1 Next C End If Rn.Comment.Text Text:=Tn Rn.Comment.Shape.TextFrame.AutoSize = True Next Cn End If End Sub

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

السلام عليكم تعديل بسيط على البرنامج ارجو ان يفي بالغرض واي ملاحظات انا موجود ارجو التجربه MMM_1.rar

تقبل الله منا ومنكم صالح الاعمال عيدكم مبارك وكل عام وانتم بخير

السلام عليكم مرفق اخي الحبيب ضاحي كافي وافي لاثراء الموضوع فقط Nadia_Offic.rar

هل البيانات في ملفين منفصلين ام في ورقتين في مصنف واحد ؟ وياريت ارفاق مثال وبه بيانات وهميه للعمل عليه

استاذ عبدالله حفظك الله ورعاك عمل في قيمة الروعة بارك الله لك في علمك وزادك اضعافا اسمح لي بااستفسار بسيط الجزئيه التاليه من الكود shp.AutoShapeType AutoShapeType و type انا حاولت استخدام type للإشارة الى نوع الشكل لحذفه فقط في المدى المعني ولم ينفذ الكود كالتالي Private Sub D_Shp() Dim Sn As Shape With ActiveSheet For Each Sn In .Shapes If Not Intersect(Sn.TopLeftCell, .Range(Sm)) Is Nothing Then If Sn.type = 183 Then Sn.Delete End If Next Sn End With End Sub هل type لاتعمل على 2007 وجزاك الله الف خير على ماتقدمه لنا من علم غزير

السلام عليكم جرب الكود التالي علي فهمت ماتريد Private Const Sm As String = "$A$2:$A$1000" Sub A_qtr() Dim الربع%, الدرجة% Dim Rn As Range, Sn As Shape ''*************** ' حط قيمة الدرجة الدرجة = 100 On Error Resume Next D_Shp For Each Rn In Range(Sm) ' المدى المراد تطبيق الكود عليه With Rn If Val(Rn) < (الدرجة / 4) And Not IsEmpty(Rn) Then Set Sn = ActiveSheet.Shapes.AddShape(183, .Left + 4, .Top + 3, .Width / 1.3, .Height - 7) With Sn .ForeColor.RGB = RGB(255, 0, 0) .BackColor.RGB = RGB(0, 170, 170) End With End If End With Next End Sub Private Sub D_Shp() Dim Sn As Shape For Each Sn In ActiveSheet.Shapes Sn.Delete Next End Sub

ارفق مثال وبه الفورم المعني