الـعيدروس

عذراً ارفقت الملف قبل ان اطلع على توضيحك اذا مشي الحال كما هو واذ تريد التعديل ابشر منتظر ردك

السلام عليكم إطلع على المرفق امل ان لايكون به اخطاء تبقا فتح المرفق ما اّليته ؟ فورم إضافة بيانات أفقيا_A1.rar

المستعلم عنه هو العمود " A " فقط ؟ اجل في أي عمود يدرج المرفق الجديد ؟ وبرضه بيانات الـ Listbox من عمود الإستعلام والعمود هو " A " فأي عمود نستخرج منه البيانات ونضعها في Listbox

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

هل خانة المرفق الجديد للإستعلام وليس إضافة عمود جديد ؟؟ هل المقصد من زر مرفق جديد للإضافه على اخر عمود فقط ام هو مربوط بمربع البحث عن الرقم وهل ادخال المرفق الجديد لإخر عمود وبعد اخر صف به بيانات للعمود الأخير وما مدى البيانات التي تدرج في Listbox من أي عمود وهل هو عمود فقط ام مدى متعدد الأعمده

السلام عليكم هل تريد تنفيذ الكود مجرد التغير في قيمة خلية " B4 " وهل المعادلات التي تريدها أكواد هي التي في الخلايا " B13 , B14 , K14 , D16 , D17 , D18 " اذا هذا ماتريده ارفق الملف وبه بيانات في ورقة " 1 " و ورقة " 2 " للتأكد من نتائج الكود وإن شاء الله خير

السلام عليكم حسب شرحك ماتقصده إظهار روؤس الأعمده فقط إبتداء من عمود " F " يعني التعديل يقتصر على روؤس الأعمده فقط هل فهمي صحيح وأرجو الرد وقتي قصير في النت حالياً كي نحاول إكماله اليوم إن شاء الله تحياتي

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

حفظ بأسم ينشاء نسخه طبق الأصل

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

السلام عليكم تفضل اعداد تقارير مدرسية_A.rar

السلام عليكم تفضل Ad_1.rar

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

السلام عليكم جرب هذا التعديل Public Sub Ali_T() Dim Sh As Worksheet Dim R As Range With Application .ScreenUpdating = False .Calculation = xlCalculationManual For Each Sh In ThisWorkbook.Worksheets If Not Sh.Name = "الكشف الرئيسي" Then For Each R In Range("A4:A500") If Not IsEmpty(R) And R.Text = Sh.Name Then Select Case R.Text Case Is = "M2" R.Offset(0, 23).Resize(1, 7).Copy Sh.Select L_a = Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row If L_a - 1 = 1 Then A = 7 Else A = L_a Sh.Range("A" & A).PasteSpecial xlPasteValues Feuil1.Select L_a = L_a + 1: A = A + 1 Case Is = "M1" R.Offset(0, 1).Resize(1, 22).Copy Sh.Select L_a = Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row If L_a - 1 = 1 Then A = 7 Else A = L_a Sh.Range("A" & A).PasteSpecial xlPasteValues Feuil1.Select L_a = L_a + 1: A = A + 1 End Select End If Next End If Next .ScreenUpdating = True .Calculation = xlCalculationAutomatic .CutCopyMode = False End With Set R = Nothing End Sub

السلام عيكم بعد اذن اخي حماده عمر استخدم هذا الكود في حدث Thisworkbook Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Ar Dim A$ '********************************************** ' أي تغير في ورقة2 يطابقة في ورقة1 , وأي تغير في ورقة4 يطابقة في ورقة 3 '********************************************** Ar = Array("ورقة2", "ورقة1", "ورقة4", "ورقة3") '********************************************** S = Ar(0): S1 = Ar(1) Select Case Sh.Name Case Is = Ar(0) A = Target.Address Sheets(Ar(1)).Range(A) = Range(A) Case Is = Ar(2) A = Target.Address Sheets(Ar(3)).Range(A) = Range(A) End Select End Sub

على أي لغة برمجه صمم البرنامج ؟

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

تفضل Public Sub Ali_Op() Dim A$, Fl_ex_A$ A = ThisWorkbook.Path & "\" & "As.exe" ' مسار ملف exe Fl_ex_A = A: Shell Fl_ex_A End Sub

السلام عليكم Public Sub Ali_Op() Dim A$, Fl_ex_A$ A = "C:\As.exe" ' مسار ملف exe Fl_ex_A = A: Shell Fl_ex_A End Sub

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

السلام عليكم فرضا خلية البحث هيا " A1 " في ورقة1 في المدى من " A:Z " Option Explicit Public Sub Ali_Serch_Sh() Dim Mat_A Dim Ws As Worksheet Dim R As Range Dim Msg_A As String, Fir_A As String Mat_A = Sheets("ورقة1").Range("A1").Value Msg_A = Mat_A & " وجدت القيمة :" & Chr(10) & " =========================== " & Chr(10) For Each Ws In Worksheets With Ws If .Name = ActiveSheet.Name Then GoTo 1 Set R = .Columns("A:Z").Find(What:=Mat_A, LookIn:=xlValues, LookAt:=xlPart) If Not R Is Nothing Then Fir_A = R.Address Do Msg_A = Msg_A & "- في ورقة " & Ws.Name & ", في الخلية " & R.Address & Chr(10) & Chr(10) Set R = .Columns("A:Z").FindNext(R) Loop While Not R Is Nothing And R.Address <> Fir_A End If End With 1 Next Ws MsgBox Msg_A End Sub جرب الكود وبلغنى بالنتائج

السلام عليكم استاذ رجب حفظك الله عمل منسق وجميل ورائع كروعه خلقك الكريم تقبل مروري

السلام عليكم طيب بعد اضافة عدد الاقسام بتظهر Comnd بعدد الرقم المسجل في Txt3 لحد هنا واضح وماذا بعد ماعمل الازرار المضافة ؟؟؟

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

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