إبراهيم ابوليله

اخى انا جربت الكود شغال تمام

اخى جرب حزف هذا السطر من الكود Application.Quit ليصبح كالاتى Sub Close1() Sheets("Welcom").Range("A50") = 0 Sheet1.Activate Application.DisplayFullScreen = False ActiveWorkbook.Close SaveChanges:=False End Sub

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

للرفع

اخى اين المرفق

اخى صلاح هذا مثال على ذلك تفضل Book1.rar

اخى جرب هذا الكود فى حدث الورقه Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = Range("a1").Address Then Cancel = True Sheet2.Select Sheet2.[A1].Select End If End Sub

اخى ضاحى مشكورا على الاهتمام ولكن ليس هذا ما اريده ماريده هو انه عند فتح هذاالملف وفى حالة وجود ملفات اخرى مفتوحه عند الظغط على زر خروج يتم غلق هذا الملف فقط ----------------------------------- ولكن عند تجربة الملف بعد تفضل حضرتك بالتعديل تم اكتشاف الاتى 1-يتم غلق الملفات باكملها 2-عند فتح اى ملف يتم فتح المفProgressBarControl-V2 ايضا

اخى ضاحى تفضل ProgressBarControl-V2.rar

للرفع

الاخوه الافاضل الحمد لله تم اكتشاف الخطأ ويصبح الكود كالاتى Sub HH() Dim X As String Dim D As Double D = CDate(Range("D2")) X = "A" For H = 2 To 100 If Cells(H, 1) = X And Cells(H, 2) >= D Then Cells(H, 3) = 10 'X = X + 1 End If Next End Sub

الاخوه الاافاضل السلام عليكم ورحمة الله وبركاته ارجو المساعده فى كود استخراج البيانات اريد عند وجود وقوع حرف A الموجود فى العمود الاول لكبر من او يساوى التاريخ الموجود فى العمود الثانى يتم ترحيل الرقم 10 فى الخليه المقابله ارجو النظر الى المرفق Book2.rar

اخى ضاحى هل من حل لهذه المشكله

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

اخى مصطفى تفضل New folder.rar

اخى سيد فقط قم باضافة الشيتات التى تريدها وقم بتسميتها ثم جرب عمل الفورم واخبرنى سجل.rar

اخى سيد هل تقصد هكذا سجل.rar

بعد إذن الأستاذي /ضاحي الغريب أستاذي إبراهيم انا جربت هذا الكود ونجح معي غير هذا الكود Application.Quit بهذا الكود ActiveWorkbook.Close False في Private Sub L_In_Click() Private Sub L_OUT_Click() اخى ضاحى بالفعل كود جمل من الاخ الجموعى بارك الله فيه وانا شخصيا كنت بستخدم ActiveWindow.Close لكن المشكله الى انا اقصدها هى بتكون فى حالة وجود الكود الاتى فى حدث الورك بوك Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.DisplayFullScreen = False Application.DisplayFormulaBar = True Application.DisplayStatusBar = False Dim strDate As String, DefPath As String Dim FileNameZip, FileNameXlsm Dim oApp As Object If ActiveWorkbook Is Nothing Then Exit Sub DefPath = ActiveWorkbook.Path If Len(DefPath) = 0 Then MsgBox "Plz Save activeworkbook before zipping" & Space(12), vbInformation, "zipping" Exit Sub End If If Right(DefPath, 1) <> "\" Then DefPath = DefPath & "\" End If strDate = Format(Now, " dd-mmm-yy h-mm-ss") FileNameZip = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".zip" FileNameXlsm = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".xlsB" On Error Resume Next If Dir(FileNameZip) = "" And Dir(FileNameXlsm) = "" Then ActiveWorkbook.SaveCopyAs FileNameXlsm newzip (FileNameZip) Set oApp = CreateObject("Shell.Application") oApp.Namespace(FileNameZip).CopyHere FileNameXlsm On Error Resume Next Do Until oApp.Namespace(FileNameZip).items.Count = 1 Application.Wait (Now + TimeValue("0:00:01")) Loop On Error GoTo 0 Kill FileNameXlsm MsgBox "completed zipped : " & vbNewLine & FileNameZip, vbInformation, "zipping" Else MsgBox "FileNameZip or/and FileNameXlsm exist", vbInformation, "zipping" Application.DisplayStatusBar = True End If '============================================================================================ End Sub Private Sub newzip(sPath) If Len(Dir(sPath)) > 0 Then Kill sPath Open sPath For Output As #1 Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) Close #1 End Sub

اخى سيدلو قمت بمراجعة الملف المرفوع فى المشاركه رقم1 سوف تجد ان عناوبن الاعمده الموجوده فى الشيت غير متطابقه مع الاعمده الموجوده بالفورم فقمت بوضع هذا الكود الموجود فى comndBottun6 lمن اجل نقل اسماء الاعمده من الفورم الى الشيت حتى تكون اعمدة الشيت متطابقه مع اعمده الفورم ----------------------------------------- بالنسبه للحفظ والتعديل انشاء الله سوف يتم عمل المطلوب

اخى ضاحى فيه سؤال محيرنى حاولت اجيب عليه بنفسى ولكنى فشلت -------------------------- ليه ما بيتم الضغط على زر خروج نهائى يتم غلق جميع الملفات المفتوحه -------------------------------+ السؤال بقى لو انا عايز اغلق الملف ده بس يبقى الكود هيكون شكله ازاى

اخى ضاحى فيه سؤال محيرنى حاولت اجيب عليه بنفسى ولكنى فشلت -------------------------- يعنى فى الموضوع الذى تفضلت به شاشة دخول برقم سري مع (( ProgressBar Control )) http://www.officena.net/ib/index.php?showtopic=52715&hl= ليه ما بيتم الضغط على زر خروج نهائى يتم غلق جميع الملفات المفتوحه -------------------------------+ السؤال بقى لو انا عايز اغلق الملف ده بس يبقى الكود هيكون شكله ازاى

اخى سيد هل تقصد هكذا سجل بحث.rar

اخى سيد هل شاهدت المرفق فى المشاركة رقم 7 على ما اعتقد ان به كل ماتريد فيه كوموبوكس يظهر فيه اسماء الصفحات وفيه يتم البحث وفيه يتم الترحيل من الليست الى التيكست

اخى سيد هل تقصد هكذا ------------- تم اضافة كود ترحيل من الليست الى التيكست --------------- شاهد المرفق سجل بحث.rar

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