عبدالله المجرب

بصراحة المطلوب غير مفهوم وبالذات في الورقة Sheet1

حسب فهمي للمطلوب ضع هذا الكود في حدث الصفحة Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, [N2:N10]) Is Nothing Then A_E = Range("A" & Target.Row) & " " & Range("B" & Target.Row) & " " & _ Range("C" & Target.Row) & " " & Range("D" & Target.Row) & " " & Range("E" & Target.Row) F_J = Range("F" & Target.Row) & " " & Range("G" & Target.Row) & " " & _ Range("H" & Target.Row) & " " & Range("I" & Target.Row) & " " & Range("J" & Target.Row) Target = A_E & " " & F_J End If End Sub

قم بمسح جميع اكواد الفورم واستبدلها بهذه Private Sub ComboBox1_Change() TextBox2.Value = Application.VLookup(ComboBox1.Value, Sheets("ورقة2").Range("a2:b7"), 2, 1) End Sub Private Sub TextBox1_Change() On Error Resume Next TextBox3.Value = TextBox1.Value * TextBox2.Value End Sub Private Sub UserForm_Activate() TextBox1.Value = 0 TextBox2.Value = 0 TextBox3.Value = 0 For x = 2 To Sheets("ورقة2").Cells(Rows.Count, 1).End(xlUp).Row ComboBox1.AddItem Sheets("ورقة2").Cells(x, 1) Next End Sub

السلام عليكم جرب تعديل كود الزر ليكون كالتالي MyName = "[name]=" & Me.tsh stDocName = "tabel-name" DoCmd.OpenReport stDocName, acPreview, , MyName مع جعل مصدر الصف في مربع التحرير والسرد هي الاسماء فقط

اخي الكريم ضع مرفق به الكود ليتم التعديل عليه للعلم ضع مرفق به اسماء الشيتات التي بالكود مع بعض البيانات التجريبية

بارك الله فيكم اخواني الكرام كرم في العطاء ومد يد العون

السلام عليكم جرب هذا التعديل Sub Abu_Ahmed() On Error GoTo 1 Dim I As Integer, MyDat1 As Date, MyDat2 As Date, AbuAhmed As Boolean MyVal1 = InputBox("ضع تاريخ البداية هنا", "إدخال") MyVal2 = InputBox("ضع تاريخ النهاية هنا", "إدخال") If Len(MyVal1) <> 10 Or Len(MyVal2) <> 10 Then Exit Sub MyDat1 = CDate(MyVal1): MyDat2 = CDate(MyVal2) AbuAhmed = True: Set Mysh = Sheets("Feuil2"): Set sh = Sheets("Feuil1") For I = 2 To sh.[A10000].End(xlUp).Row If sh.Cells(I, 5) >= MyDat1 And sh.Cells(I, 5) <= MyDat2 Then sh.Cells(I, 1).Resize(1, 41).Copy Mysh.Range("A" & Mysh.[A10000].End(xlUp).Row + 1) End If Next Set Mysh = Nothing: Set sh = Nothing 1: If AbuAhmed Then MsgBox "تم الترحيل": Exit Sub MsgBox "خطاء في ادخال التاريخ" End Sub

شاهد هذه الروابط http://www.officena.net/ib/index.php?showtopic=41347 http://www.officena.net/ib/index.php?showtopic=38766&st=0&p=211998&#entry211998

لا شكر على واجب

السلام عليكم تخفيض مستوى الأمان للماكرو في الاكسيل 2007 و خطواته سهله : 1. من زر الاوفيس 2 .Excel Option . 3. Trust Center 4. Trust Center setting 5. Macro Setting . 6. Enable All Macros . ثم قم بإغلاق البرنامج و اعادة فتحه و ستعمل جميع الأكواد إن شاء الله ومن هنا شرح مصور لكن لاكسل فرنسي http://www.officena.net/ib/index.php?showtopic=32140

اختي ام باسل بما ان الدالة معرفة يجب تمكين وحدات الماكرو (تخفيض الأمان) == اي نسخة من الاوفيس تستعملين

السلام عليكم تم اضافة دالة معرفة وذلك لتجاوز حالات التاريخ الهجري === كما تم اضافة عمود لحساب التاريخ بدون ايام الجمعة والخميس === اختي الفاضلة جربي المرفق الدورات التدريبيه للموظفات - فرع جدة.rar

اختي أم باسل الاستاذ بن عليه يقصد عنوان الموضوع (الرجاء مساعدتي بملف الاكسيل المرفق) وذلك لمخالفته قواعد المشاركة === سأقوم بتعديل العنوان وكل الشكر للاستاذ بن عليه للتنبيه

السلام عليكم هذه دالة معرفة لحساب التاريخ الهجري أو الميلادي Function MyDatCunt(TR As Range, TT As Range) As String MyDatCunt = CDate(TT) - CDate(TR) + 1 End Function

حياك الله اخي الكريم (الصمت المتحدث) الحمدلله انك استفدت من الموضوع

بارك الله فيك اخي احمد

السلام عليكم في اكثر من موضوع يتم طلب تسلسل في استعلام واغلب الردود تقرن الحل بربط الاستعلام بجدول في المرفق قمت بالتعديل على دالة (منقولة) لعمل تسلسل في استعلام دون الحاجة الى ربط بجدول كما ان الدالة ستعمل مع اي استعلام الرجاء تجربة المرفق وابداء الرائ فهذه محاولات لتعلم الاكسس للعلم فالتسلسل يعمل حتى مع المعايير (Qry بدون معييار و Qry1 بمعييار) تسلسل استعلام.rar

السلام عليكم جرب الكود بعد التعديل لن تحتاج الى خلايا للتاريخ Sub Abu_Ahmed() On Error GoTo 1 Dim I As Integer, MyDat1 As Date, MyDat2 As Date, AbuAhmed As Boolean MyDat1 = CDate(InputBox("ضع تاريخ البداية هنا", "إدخال")) MyDat2 = CDate(InputBox("ضع تاريخ النهاية هنا", "إدخال")) AbuAhmed = True: Set Mysh = Sheets("Feuil2"): Set sh = Sheets("Feuil1") For I = 2 To sh.[A10000].End(xlUp).Row If sh.Cells(I, 5) >= MyDat1 And sh.Cells(I, 5) <= MyDat2 Then sh.Cells(I, 1).Resize(1, 41).Copy Mysh.Range("A" & Mysh.[A10000].End(xlUp).Row + 1) End If Next Set Mysh = Nothing: Set sh = Nothing 1: If AbuAhmed Then MsgBox "تم الترحيل": Exit Sub MsgBox "خطاء في ادخال التاريخ" End Sub

اخي الفاضل لا يوجد فورم في الملف

اشكر جميع من شارك بهذا الموضوع واحسب ان اخواني الكرام احمد فضيلة وجمال الدغيدي قد قاما بالواجب في الردود وشكراً

الاساتذة الكرام عبدالله باقشير ابو أدم ابو خليل شكراً لكم على مشاعركم الكريمة

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

اخي ابن بنها السبب اعتقد انه وجود حماية على الملف

سوال اي الاعمدة هي المعتمدة في اعتماد تاريخ الترحيل عليها E او D ================================ انا اعتمدت على E ضع هذا الكود في زر أمر في الورقة Feuil1 Sub Abu_Ahmed() Dim I As Integer, MyDat1 As Date, MyDat2 As Date Set Mysh = Sheets("Feuil2") MyDat1 = Mysh.[E5]: MyDat2 = Mysh.[F5] For I = 2 To [A10000].End(xlUp).Row If Cells(I, 5) >= MyDat1 And Cells(I, 5) <= MyDat2 Then Cells(I, 1).Resize(1, 41).Copy Mysh.Range("A" & Mysh.[A10000].End(xlUp).Row + 1) End If Next Set Mysh = Nothing End Sub

شكراً لك استاذ تومي محمد