الـعيدروس

انا جربت الملف على أوفيس 2003 و 2007 ويعمل بشكل ممتاز الأخوه الاحبه بعد تشغيل الكود ارجو الذهاب الى محرر الاكواد ثم قائمة Tools ثم References والتأكد من الجمله التاليه إن كان المربع المقابل لها محفز ام لا Microsoft Visual Basic for Applications Extensibility 5.3

السلام عليكم إضغط على الزر المسمى تشغيل في ورقة الزر A_Sh1.rar

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

السلام عليكم عذرا لم انتبه ان الكود يحدث خطاء جرب هكذا شغل الكود المسمى Ali_Ad_Ref Public Sub Ali_Ad_Ref() On Error Resume Next ActiveWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 0, 0 '************************* Call Ali_AddB '************************* End Sub Private Sub Ali_AddB() Dim S$, C, T, i, ii Dim Sh As Shape Dim Op As VBComponent Dim Opj As VBComponent T = 1 On Error Resume Next For Each Sh In ActiveSheet.Shapes If ActiveSheet.Shapes.count > 0 Then Sh.Delete End If Next If IsError(Op) = False Then Else GoTo 0 Set Op = ActiveWorkbook.VBProject.VBComponents("A_Mod") ActiveWorkbook.VBProject.VBComponents.Remove Op 0: Set Opj = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule) Opj.Name = "A_Mod" For i = 1 To Sheets.count If Sheets(i).Name = ActiveSheet.Name Then GoTo 1 With Opj.CodeModule C = .CountOfLines + 1 .InsertLines C, "Sub my_" & i & "()" & Chr(13) & _ " Sheets(" & i & ")" & ".Select" & Chr(13) & "End Sub" End With ActiveSheet.Buttons.Add(Cells(1, 1).Left, T, 89.25, 23.25).Select S = Selection.Name Selection.Caption = Sheets(i).Name Selection.OnAction = "my_" & i T = T + 24 1 Next End Sub

السلام عليكم نفس الطريقة السابقه في إدراج كود جرب هذا الكود الأن شغل الكود عدة مرات طبيعي لايؤثر لانه يقوم بحذف الأزرار السابقه وبرضه يحذف الأكواد المسماه "my_ 1 " ماعليك سوى إدراجه في Module1 وتشغيله Public Sub Ali_AddB() Dim S$, C, T, i, ii T = 1 On Error Resume Next Dim Op As VBComponent Dim Opj As VBComponent For ii = 1 To ActiveSheet.Shapes.Count If ActiveSheet.Shapes.Count > 0 Then ActiveSheet.Shapes(ii).Delete End If Next Set Op = ActiveWorkbook.VBProject.VBComponents("A_Mod") ActiveWorkbook.VBProject.VBComponents.Remove Op Set Opj = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule) Opj.Name = "A_Mod" For i = 1 To Sheets.Count If Sheets(i).Name = ActiveSheet.Name Then GoTo 1 With Opj.CodeModule C = .CountOfLines + 1 .InsertLines C, _ "Sub my_" & i & "()" & Chr(13) & _ " Sheets(" & i & ")" & ".Select" & Chr(13) & _ "End Sub" End With ActiveSheet.Buttons.Add(Cells(1, 1).Left, T, 89.25, 23.25).Select S = Selection.Name Selection.Caption = Sheets(i).Name Selection.OnAction = "my_" & i T = T + 24 1 Next End Sub

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

الظاهر ان حجم الملف كبير إضغط الملف اول مره ثم انشاء مجلد جديد وحط الملف المضغوط السابق فيه ثم إضغط المجلد الجديد وجرب إرفقه

السلام عليكم جرب المرفق Ad_2.rar

ادراج الكود يكون في مودويل ليس في حدث ورقة كما شرحت لك سابقاً أنا جرب الكود يمل بكفائه إذا تقدر ترفق ملفك أطبق الكود عليه فلا بأس منتظر ردك

السلام عليكم تفضل كود حدث ListBox1_Click Private Sub ListBox1_Click() On Error Resume Next ii = 2 For i = 0 To Me.ListBox1.ColumnCount Me.Controls("TextBox" & ii).Value = Me.ListBox1.List(ListBox1.ListIndex, i) ii = ii + 1 Next End Sub

ملفك هل يوجد فيه أكواد ؟؟ اذا به اكواد الصق الكود في Module1 وحذف جميع الأكواد المسماه "my_ 1 " و "my_ 2 " حتى اخر كود

الورقتين فارغه ؟؟ لاأدري من أين يتم جلب القيم من اي مدى ضيف بيانات وهمي في كلا الورقتين وارفق الملف

ليس هكذا اظغط زر Alt + F11 ثم اذهب الى قائمة Insert اختار Module ثم الصق كود في Module بعدها اذهب الى الورقة الجديدة وإضغط Alt + F8 اختار الكود المسمى Ali_AddB ثم تشغيل

ماهي الأعمدة المراد جلب قيمها بين تاريخين لإن مدى الـ 4 أوراق يختلف عن ورقة شهري ؟؟

السلام عليكم إضغطي زر " F9 " إن إشتغلت المعادله وجمعت مزبوط فروحي لقائمة أدوات ثم خيارات ثم حساب وحفزي حساب تلقائي ثم موافق

السلام عليكم إنشاء ورقة جديدة في ملفك وإستخدم الكود التالي مرة واحده فقط Public Sub Ali_AddB() Dim S$, C, T, i, ii T = 1 On Error Resume Next For ii = 1 To ActiveSheet.Shapes.Count If ActiveSheet.Shapes.Count > 0 Then ActiveSheet.Shapes(ii).Delete End If Next For i = 1 To Sheets.Count If Sheets(i).Name = ActiveSheet.Name Then GoTo 1 With ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule C = .CountOfLines + 1 .InsertLines C, _ "Sub my_" & i & "()" & Chr(13) & _ " Sheets(" & i & ")" & ".Select" & Chr(13) & _ "End Sub" End With ActiveSheet.Buttons.Add(Cells(1, 1).Left, T, 89.25, 23.25).Select S = Selection.Name Selection.Caption = Sheets(i).Name Selection.OnAction = "my_" & i T = T + 24 1 Next End Sub

السلام عليكم تفضل اضافة صفين نت التكست بوكس وترحيلها_A.rar

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

السلام عليكم إطلع على المرفق به طريقة ربما تفيدك Leb_A.rar

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

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

السلام عليكم أولا اهلا بك عضو جديد في منتدى أوفسينا الرائد *********************************************************** إما عن طريق خصائص التكت بوكس تجد خاصية المسماه " ControlTipText " إكتب في المربع المقابل لها ماتشاء وسوف يظهر مجرد النقر على التكست بوكس أو إستعن بهذا الكود انسخه والصقه في حدث الفورم إن كان حدث UserForm_Activate ليس مستخدما Private Sub UserForm_Activate() With Me .TextBox1.ControlTipText = "إدخل قيم فقط في هذا التكست " .TextBox2.ControlTipText = " مربع إدخال العنوان " .TextBox3.ControlTipText = "مربع إدخال العنوان " End With End Sub وإن كان مستخدم لديك في الفورم إنسخ التالي والصقه ضمن الحدث With Me .TextBox1.ControlTipText = "إدخل قيم فقط في هذا التكست " .TextBox2.ControlTipText = " مربع إدخال العنوان " .TextBox3.ControlTipText = "مربع إدخال العنوان " End With

السلام عليكم جرب المرفق فورم إضافة بيانات أفقيا_A3.rar

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

اطلع على المرفق عدلت الاضافة تكون بنفس صف الاستعلام واخر عمود به بيانات +1 لصف الاستعلام تم التعديل 10:34 تم التعديل فورم إضافة بيانات أفقيا_A2.rar