DBA.Oracle

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

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

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

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

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

اخترت اسم مستخدم وكتبت كلمة مرور خطأ فذهب مرة اخري الي صفحة تسجيل صحيح للاسف

اخي احمد زمان لك فائق الشكر علي المساعدة لكن المشكلة لازالت قائمة وفى المرفق شرح فيديو لما يحدث معي عند استخدام ملفك الاخير Result.rar

تدخل اسم المستخدم ولا تدخل كلمة مرور فيدخل علي تسجيل صحيح وحتي لو تركت المدخلات كلها فارغة بدون كتابة فيدخل علي دخول صحيح

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

الاستاذ / احمد زمان شكرا لمحاولة المساعدة لكن للاسف المشكلة ما زالت قائمة برجاء مراجعة الرد 14

قمت بعدم ادخال ولا اسم مستخدم ولا كلمة مرور فذهب لصفحة دخول سليم قمت بإدخال اسم صحيح ومرور صحيح فذهب الي دخول خطأ قام بالعكس

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

الكود يعمل بعد تعديلك المميز اخي يحي جزاك الله كل خير ومبروك علي الموقع ودائما الي الامام ان شاء الله

اخي يحي برجاء محاولة الدخول باليوزر u2 او u3 ولك جزيل الشكر

اعتذر عن خطأ جسيم فى المرفق برجاء استخدام Ctrl+Break لتجاوز الخطأ

اخي احمد زمان فى المرفق مثال علي ما اقصد اخي يحي جزاك الله كل خير علي المساعدة لكن بصراحة مازال الكود لا يعمل معي فلو ممكن نظرة سريعة علي المرفق وجزاكم الله كل خير accounts_test.rar

اذا فرضنا ان عندنا صفحة اسمها Accounts بها اسماء الاكونتات العمود A يحتوي علي اسماء الاكونتات والعمود B يحتوي علي كلمات المرور فعند الضغط علي دخول يقوم بمقارنة المدخلات الحالية بالمعلومات الموجودة مسبقا حاولت كتابة هذا الكود لكن فيه خطأ لا اعلمه بصراحة ممكن مساعدة فى تعديله وجزاكم الله كل خير For i = 2 To 100 If ComboBox1.value = Sheets("Accounts").Cells(i, "A") And TextBox1.value = Sheets("Accounts").Cells(i, "B") Then MsgBox "ok" End if Next i

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

نعم اخى يحي لا يوجد مشكلة فى الكود جزاك الله كل خير انظر ردي السابق لك جزيل الشكر

Dim i As Integer, sh As Worksheet For Each sh In Destwb.Worksheets For i = 4 To 115 If sh.Range("B" & i).Value = 0 Then sh.Rows(i & ":" & i).EntireRow.Hidden = True End If Next i Next sh For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh هكذا يعمل الكود فصلت الاثنين عن بعضهما جزاك الله كل خير اخى يحي لك فائق الشكر والتقدير

اخي يحي ااسف مرة اخري لكن هناك شيء بسيط بعد اذنك الكود بعد تعديلك له يعمل ممتاز لكن عند محاولتي اضافته لكود الارسال تحدث نفس المشكلة القديمة انه ينفذ فقط علي الصفحة الاولي فهل من تعديل اخر لظبطه Set Destwb = ActiveWorkbook Dim i As Integer, sh As Worksheet For Each sh In Destwb.Worksheets For i = 4 To 115 If sh.Range("B" & i).Value = 0 Then sh.Rows(i & ":" & i).EntireRow.Hidden = True End If Next i sh.Select With sh.UsedRange .Cells.copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh هذا هو الكود بعدما اضفته الي كود الارسال والنتيجة كما اخبرتك فهل من تعديل اخر من ابداعك وجزاك الله كل خير

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

جربت الكود هكذا يقوم بتنفيذه علي اول صفحة فقط Dim i As Integer For i = 4 To 115 If Range("B" & i).Value = 0 Then For Each Worksheet In ThisWorkbook.Worksheets Rows(i & ":" & i).EntireRow.Hidden = True Next Worksheet End If Next i

Dim i As Integer For Each Worksheet In ThisWorkbook.Worksheets For i = 4 To 115 If Range("B" & i).Value = 0 Then Rows(i & ":" & i).EntireRow.Hidden = True End If Next i Next Worksheet يقوم بتنفيذ الامر علي الصفحة الاولي فقط من الصفحات المختارة المفروض ان الكود يخليه لو انا اخترت 2 علشان يعملهم كوبي ويضعهم فى وورك شيت جديد ويعملهم مرفق فى رسالة ينفذ الكود علي الصفحتين وليس علي الاولي فقط فما الخطأ هنا ؟ :s

ودا كود الارسال Sub Mail_Sheets_Array() 'Working in 2000-2010 Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet Dim TheActiveWindow As Window Dim TempWindow As Window With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook 'We add a temporary Window to avoid the Copy problem 'if there is a List or Table in one of the sheets and 'if the sheets are grouped With Sourcewb Set TheActiveWindow = ActiveWindow Set TempWindow = .NewWindow .Sheets(Array("Sheet1", "Sheet3")).Copy End With 'Close temporary Window TempWindow.Close Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2010, we exit the sub when your answer is 'NO in the security dialog that you only see when you copy 'an sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With ' 'Change all cells in the worksheets to values if you want ' For Each sh In Destwb.Worksheets ' sh.Select ' With sh.UsedRange ' .Cells.Copy ' .Cells.PasteSpecial xlPasteValues ' .Cells(1).Select ' End With ' Application.CutCopyMode = False ' Destwb.Worksheets(1).Select ' Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " _ & Format(Now, "dd-mmm-yy h-mm-ss") Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = "ron@debruin.nl" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "Hi there" .Attachments.Add Destwb.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Send 'or use .Display End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub