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

السلام عليكم من باب التنويع يمكن استعمال كود هذه الدالة Sub Abu_Ahmed() x = Application.RandBetween(999, 10000) [H5] = x End Sub

ما شاء الله يا وِليدي المثل يقول من طول الغيبات جاب الغنايم سلمت يداك ابا ابراهيم

السلام عليكم هذا الكود يقوم بالاتي بكل ضغطة زر سيضيف للخلية 1 حتى يصل الى 48 ثم ينتقل الى الخلية التي بعدها وهكذا بنفس تسلسل طلبك Sub Abu_Ahmed_NewTwzee3() Application.ScreenUpdating = False c = 3: r = 1: T = 15 Do Until Cells(T, c) = "" If Cells(T, c) < 48 Then Exit Do If r > 48 Then Exit Sub T = T + 2 If T > 21 Then T = 15 c = c + 1 End If Loop Cells(T, c).Select Cells(T, c) = Cells(T, c) + 1 Exit Sub Application.ScreenUpdating = True End Sub

جرب هذا الكود Private Sub Frame1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Len(Trim(TextBox1)) = 0 Then Cancel = True If Len(Trim(TextBox2)) = 0 Then Cancel = True End Sub

هذا هو الرابط http://www.officena.net/ib/index.php?showtopic=28195&st=20 لكن للاسف روابط التحميل لا تعمل

اخي الفاضل اخر زيارة للاخ علوش في 11/4/2011 اي قبل حوالي السنة فلا اعتقد انه سيرد على الاستفسارات وان كنت اتمنى ان يتواجد بييننا للرد على الاستفسارات ولكن الخير في الموجودين وهم من اعمدة المنتدى وعلى راسهم ابو ادم وابو خليل

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

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

شاهد هذا الرابط http://www.officena.net/ib/index.php?showtopic=37989 او هنا http://www.officena.net/ib/index.php?showtopic=40885

السلام عليكم بعد إذن الاستاذ طارق من هنا اخذ الحل http://www.officena....showtopic=37813 قم بفك ضغط الملف ثم استعمل الزر ===== في المرفقات احدى الصور التي تم حفظها حفظ كصورة.rar

ما اجمل تواضع العلماء

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

جرب هذه الاكواد في حدث الفورم Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If TextBox1.Value = "" Then TextBox1.SetFocus End Sub Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If TextBox1.Value = "" Then TextBox1.SetFocus End Sub Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If TextBox1.Value = "" Then TextBox1.SetFocus End Sub Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If TextBox1.Value = "" Then TextBox1.SetFocus End Sub

بعد إذن الاستاذ رجب تفضل المرفق salary. .rar

حياك الله اخي فضل اخي الشهابي كلامك احرجني فانا لم اقدم الا ما تعلمته فقط حياك الله اخي ابراهيم

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

تم عمل الاتي 1. بعد إستدعاء البيانات يتم عمل قائمة منسدلة بالتواريخ التي بها بيانات (وعند إختيار تاريخ يتم عرص القيمة) 2. زر اضافة بيانات 3. زر لتديل البيانات واضافة بيانات حسب تواريخ جديدة تعديل فورم.rar

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

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

اخي محمد شكراً لك ان شاء الله وفي الجزء الثاني ما طلبت اخي رضا شكراً لمرورك

السلام عليكم قمت بعمل كود جديد يعتمد على التصفية المتقدمة حسب شروطك فان لم تكن هناك ورقة عمل بالاسم الموجود في الخلية يتم اضافة ورقة جديدة بهذا الاسم وترحيل البيانات اليها وان كانت موجودة يتم تخييرك ما بين الترحيل من عدمه فان اخترت الترحيل يتم الترحيل اسفل البيانات السابقة Sub Abu_Ahmed_Filter() Set MySh = Sheets("بيانات") shName = [F3] For i = 1 To Sheets.Count If Sheets(i).Name = shName Then Reply = MsgBox("هذه الورقة موجودة مسبقاً" & Chr(10) & "هل تريد ترحيل البيانات اليها على أية حال", vbYesNo, "تنبيه") If Reply = vbYes Then GoTo 1 Exit Sub End If Next Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = shName 1: LR = Sheets(shName).[A10000].End(xlUp).Row + 1 MySh.[B4:N15000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=MySh.[As1:AV2], _ CopyToRange:=Sheets(shName).Range("A" & LR & ":M" & LR), Unique:=False End Sub بيانات.rar

اخي فضل قبل الرد عليك اليكم اخواني الجزء الثاني من الشرح وملف الشرح في المرفقات الترحيل2.rar

هل تقصد هكذا Book1 (3).rar

هذا بسبب اختيار تحديد الصف الاخير الى نفس العمود Cells([B1000].End(xlUp).Row + 1, 2) = TextBox1.Value Cells([c1000].End(xlUp).Row + 1, 3) = TextBox3.Value يمكنك تحديد العمود B فقط هكذا Cells([B1000].End(xlUp).Row + 1, 2) = TextBox1.Value Cells([B1000].End(xlUp).Row + 1, 3) = TextBox3.Value