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

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

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

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

السلام عليكم استبدل الكود السابق بهذا Private Sub CommandButton3_Click() Dim T As Integer, i As Integer If Val(Label5) And OptionButton1.Value = True Then For i = 1 To Val(Label5) Label5.Caption = Val(Label5) - 1 With Sheets("Sheet1") Endrow = .Range("A1").CurrentRegion.Rows.Count .Cells(Endrow + 1, 1).Value = Endrow .Cells(Endrow + 1, 2).Value = TextBox1.Value .Cells(Endrow + 1, 3).Value = TextBox2.Value .Cells(Endrow + 1, 4).Value = TextBox3.Value .Cells(Endrow + 1, 5).Value = TextBox4.Value End With Next ClerMe For T = 2 To 3 If Val(Me.Controls("Label" & T + 4)) > 0 Then Me.Controls("OptionButton" & T) = True: Exit Sub Next End If '======================================= If Val(Label6) And OptionButton2.Value = True Then For i = 1 To Val(Label6) Label6.Caption = Val(Label6) - 1 With Sheets("Sheet1") Endrow = .Range("A1").CurrentRegion.Rows.Count .Cells(Endrow + 1, 1).Value = Endrow .Cells(Endrow + 1, 2).Value = TextBox1.Value .Cells(Endrow + 1, 3).Value = TextBox2.Value .Cells(Endrow + 1, 4).Value = TextBox3.Value .Cells(Endrow + 1, 5).Value = TextBox4.Value End With Next ClerMe If Val(Label7) > 0 Then OptionButton3.Value = True: Exit Sub End If '==================================================== If Val(Label7) And OptionButton3.Value = True Then For i = 1 To Val(Label7) Label7.Caption = Val(Label7) - 1 With Sheets("Sheet1") Endrow = .Range("A1").CurrentRegion.Rows.Count .Cells(Endrow + 1, 1).Value = Endrow .Cells(Endrow + 1, 2).Value = TextBox1.Value .Cells(Endrow + 1, 3).Value = TextBox2.Value .Cells(Endrow + 1, 4).Value = TextBox3.Value .Cells(Endrow + 1, 5).Value = TextBox4.Value End With Next ClerMe If Val(Label5) Then OptionButton1.Value = True: Exit Sub If Val(Label6) Then OptionButton2.Value = True: Exit Sub End If End Sub Sub ClerMe() For i = 1 To 4 Me.Controls("TextBox" & i) = Clear Next End Sub

تم تعديل العنوان نرجو الالتزام بقواعد المشاركة

ضع مرفق به الكود لفهم آلية الكود

وما هو الفاصل الذي تريد بين كل عملية ترحيل

بصراحة المطلوب غير مفهوم

ضع هذا السطر On Error GoTo 1 في بداية الكود هكذا Private Sub أمر0_Click() On Error GoTo 1 وفي نهاية الكود استبدل هذا السطر End Sub بهذا 1 End Sub وبذلك عند الغاء الحذف سيتم الخروج من الاجراء والله اعلم

السلام عليكم ضع هذا الكود في زر الطباعة Private Sub CommandButton1_Click() CommandButton1.Visible = False For i = 0 To 3 If Val(Me.Controls("Label" & i + 1)) > 0 Then Me.MultiPage1.Value = i UserForm1.Printform End If Next Unload Me End Sub

السلام عليكم بدايةً هل الكود صحيح وفعال

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

حسب فهمي اختصرت لك الكود ليصبح كالتالي Private Sub CommandButton3_Click() Dim T As Integer, i As Integer For T = 1 To 3 If Val(Me.Controls("Label" & T + 4)) > 0 Then Me.Controls("OptionButton" & T) = True If Me.Controls("OptionButton" & T) And Val(Me.Controls("Label" & T + 4)) > 0 Then For i = 1 To Val(Me.Controls("Label" & T + 4)) Me.Controls("Label" & T + 4).Caption = Val(Me.Controls("Label" & T + 4)) - 1 With Sheets("Sheet1") Endrow = .Range("A1").CurrentRegion.Rows.Count .Cells(Endrow + 1, 1).Value = Endrow .Cells(Endrow + 1, 2).Value = TextBox1.Value .Cells(Endrow + 1, 3).Value = TextBox2.Value .Cells(Endrow + 1, 4).Value = TextBox3.Value .Cells(Endrow + 1, 5).Value = TextBox4.Value End With Next End If Next TextBox1.Value = Clear TextBox2.Value = Clear TextBox3.Value = Clear TextBox4.Value = Clear End Sub فبالعدد الموجود في الليبلات سيتم ترحيل المدخلات في TextBox تباعاً والله اعلم

السلام عليكم يظهر التصدير هكذا هل فيه خلل

شكراً لمروك اخي حماده عمر

ما المطلوب بالضبط وما مواصفات الواجهة التي تريد

السلام عليكم اعتقد ان الخطاء ناتج عن اعدادات اللغة في الويندوز جرب الاتي من Control Panel اذهب الى Region and Language قم بضبط اللغة واختر اللغة العربية وان شاء الله يتم عمل البرنامج والله اعلم

السلام عليكم فقط غير موقع السطر DoCmd.runsql "DELETE tbl1.*FROM tbl1;" في حدث النقر على زر الاستيراد الى بعد هذا السطر If strPathFile = "" Then MsgBox "تم الغاء العملية", vbOK, "No Selection" Exit Sub End If ليصبح هكذا If strPathFile = "" Then MsgBox "تم الغاء العملية", vbOK, "No Selection" Exit Sub End If DoCmd.runsql "DELETE tbl1.*FROM tbl1;" والله اعلم

السلام عليكم هذا رد منقول للاستاذة زهرة اضعه للفائدة Dim BD As DAO.Database Dim TB As DAO.Recordset Set DB = OpenDatabase ("C:\Folder\TableDB.mdb") 'ضع مسار قاعدة بيانات الجداول الخاصة بك هنا Set TB = DB.OpenRecordset("Items", DB_OPEN_TABLE) Do While Not TB.EOF If TB!Balance <= TB!LowLimt Then MsgBox "رصيد متدني لصنف : " & TB!ItemName, vbInformation End If TB.MoveNext Loop TB.Close Set TB = Nothing Set DB = Nothing او استخدم هذا الكود Dim BD As DAO.Database Dim TB As DAO.Recordset Dim strPath as String strPath= "C:\Folder\TableDB.mdb" 'ضع مسار قاعدة بيانات الجداول الخاصة بك هنا Set DB = DBEngine.Workspaces(0).OpenDatabase(strPath, True) Set TB = DB.OpenRecordset("Items", DB_OPEN_TABLE) Do While Not TB.EOF If TB!Balance <= TB!LowLimt Then MsgBox "رصيد متدني لصنف : " & TB!ItemName, vbInformation End If TB.MoveNext Loop TB.Close Set TB = Nothing Set DB = Nothing

حسب علمي لا يمكن ان يتم تفعيل 2 مع بعض والله اعلم

هناك عدة طرق وبالاكواد او بالدوال ضع مرفق ليتم الحل فيه

السلام عليكم هل تقصد هكذا مرة واحدة.rar

السلام عليكم كان الله في العون

بصراحة المطلوب غير مفهوم وهناك خطاء في دالة VLOOKUP

السلام عليكم شاهد هذا الموضوع http://www.officena.net/ib/index.php?showtopic=37604&hl=