ياسر خليل أبو البراء

أنا جربت الملف ويعمل بشكل جيد على أوفيس 2013 ممكن أحد الأخوة الكرام يجرب ويقولنا على النتيجة فيه فكرة تانية إنك تستخدم فورم لإدخال كلمة السر أفضل من صندوق الإدخال ومن خلال الفورم تضع مربع نص وتخلي خاصية معينة Input Mask تخلي جمبها علامة نجمة عشان يظهر الباسورد على شكل نجوم

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

أخي الكريم خالد يرجى تغيير اسم الظهور للغة العربية إليك الملف التالي عله يفي بالغرض (طلبت منك التوضيح من البداية لكي لا يلتبس الأمر على الأخوة الأعضاء) تقبل تحياتي Count Qty YasserKhalil.xlsx

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

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

أخي الكريم خالد أهلاً بك في المنتدى يرجى توضيح شكل المطلوب أي النتائج المتوقعة لتجد المساعدة من الأخوة الأعضاء الأرقام من 1 إلى 7 على ما أعتقد أنها تمثل الشهور ..وهل بقية الشهور 8 - 12 مطلوبة أم هذه الشهور فقط مزيد من التوضيح

جرب الملف التالي InputBox Password Mask.rar

بسم الله ما شاء الله أخي الغالي المتميز مختار تسلم الأيادي وتكيد الأعادي .. تسلم يا ابن بلادي إليك زيادة في الخير .. دالة لدمج القيم في خلية واحدة ويمكنك تحديد نوع الفاصل بين القيم من خلال المعادلة Public Function Concat(MyRange As Range, Optional myDelimiter As String) '=Concat(C9:I14," ") Dim rCell As Range Application.Volatile For Each rCell In MyRange Concat = Concat & rCell & myDelimiter Next rCell If Len(myDelimiter) > 0 Then Concat = Application.WorksheetFunction.Trim(Left(Concat, Len(Concat) - Len(myDelimiter))) End If End Function تقبل تحياتي

أخي الحبيب سليم بارك الله فيك وجزاك الله خير الجزاء في الدنيا والآخرة عمل رائع وجميل جداً ما رأيك بتعديل بسيط لن يؤثر في عمل الكود أرى أنك تكثر من التحديد والتحديد لا قيمة له ... قم بالإطلاع على الكود بالشكل التالي Sub FindEmptyCell() Dim LR&, R& Application.ScreenUpdating = False LR = Cells(Rows.Count, 1).End(3).Row If LR < 2 Then LR = 2 Range("B2:C" & LR + 1).ClearContents For R = 2 To LR With Range("A" & R) If IsEmpty(.Value) Then .Offset(0, 1) = .Address Else .Offset(0, 2) = .Address End If End With Next Application.ScreenUpdating = True End Sub

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

لابد أن تكون عدد عناصر المصفوفة واحدة بمعنى عدد الصفوف المشار إليها في نطاق الجمع ونطاق الشروط لابد أن يكون بنفس العدد F6:F11 هنا 6 عناصر أو 6 صفوف A6:A11 هنا أيضاً 6 عناصر في المصفوفة أما الجزء التالي G9:G11 فيحتوي 3 عناصر فجرب أن تقوم بتغيير الجزء المخالف إلى G9:G14 ستجد أنه لا يوجد خطأ إن شاء الله

لا يوجد ملف مرفق يرجى إرفاق الملف وتوضيح المطلوب بشكل تفصيلي (بلاش شغل كلمتين وبس بتوع فؤاد المهندس)

قم بإرفاق الملف الذي أرفقته لك مسبقاً حيث أنه مع الترقية يبدو أن هناك مشكلة في المرفقات الملف بعد التعديل وليس الملف الأول

المشكلة أخي الكريم في تصميم ملفك .. اتضح لي أنه لا يمكن الاعتماد على العمود السادس حيث أن البيانات المرحلة قد تكون فارغة في هذا العمود وهذا ما يحدث المشكلة... راعي أن موضوع دمج الخلايا يسبب المشاكل مع الاكواد عموماً جرب هذا الكود .. ولا تنسى أن تحدد أفضل إجابة Sub CutRow() Dim WS As Worksheet, SH As Worksheet, LR As Long, I As Long Dim Cell As Range Set WS = Sheets(" الخطة النظريةو التنفيذ الفعلي"): Set SH = Sheets("البنود المنتهية") Application.ScreenUpdating = False For Each Cell In WS.Range("N5:N" & WS.Cells(Rows.Count, 1).End(xlUp).Row) If Cell.Value >= 1 Then LR = IIf(SH.Cells(Rows.Count, 1).End(xlUp).Row <= 3, 4, SH.Cells(Rows.Count, 1).End(xlUp).Row + 1) Cell.EntireRow.Copy SH.Range("A" & LR) End If Next Cell For I = WS.Cells(Rows.Count, 1).End(xlUp).Row To 5 Step -1 If Cells(I, "N").Value >= 1 Then Cells(I, "N").EntireRow.Delete End If Next I Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

يبدو أنك عدلت في الكود في مكان ما فأدى للخطأ .. لا يسعني الوقت لكي أدقق فيما فعلت ... قمت بنسخ الكود الأول وعدلت السطر كما أخبرتك ويعمل الملف بشكل جيد الآن يرجى تحديد أفضل إجابة من خلال النقر على علامة الصح في الجزء الأيمن من المشاركة التي أعجبتك وأدت الغرض Test This.rar

يرجى مزيد من التوضيح ما هي المعادلة التي تريد تطبيقها يكفي أن تعدل في الكود الأول في المشاركة الأولى بأن تجعل الإزاحة -1 بدلاً من 1 مع الدالة Offset

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

المشكلة في دمج الخلايا في الصفوف الأولى ولتفادي هذا الأمر قم بالتعديل بحيث يكون الاعتماد على العمود السادس حيث أن آخر خلية غير مدمجة فيه غير السطر التالي فقط في الكود LR = IIf(SH.Cells(Rows.Count, 6).End(xlUp).Row <= 3, 4, SH.Cells(Rows.Count, 6).End(xlUp).Row + 1)

ما هي النتائج المتوقعة في العمود الأول ... هل تريد ترقيم البيانات في العمود الأول أم وضع معادلة .. يرجى التوضيح جرب الكود التالي للترقيم Sub AutoFill() With Range("B6", Range("B" & Rows.Count).End(xlUp)) .SpecialCells(2).Offset(, -1).Formula = "=IF(B6<>"""",COUNTA($B$6:B6),"""")" End With With Range("A6", Range("A" & Rows.Count).End(xlUp)) .Value = .Value End With End Sub

هشرح لك الخطوات وإنت نفذها على ملفك بنفسك روح لمحرر الأكواد ومن قايمة Insert قم بإدراج Class Module وسميه PwdInputBox وبعدين الصق الكود التالي فيه '--------------------------------------------------------------------------------------- ' ClassModule : PwdInputBox ' DateTime : 30/07/02 10:30 ' Last modified : 31/07/02 08:49 ' Author : Juan Pablo Gonzalez ' Special thanks to Ivan F Moala for pointing the right way ' Purpose : Shows a standard InputBox but with the cabalitie to have a PasswordChar ' for the text entered. ' Parameters : Prompt As String, required. Text to show on the InputBox ' PasswordChar As String, optional. Character to show as PasswordChar. ' If vbNullString is entered, the text will show up normally. ' Title As String, optional. Title of the InputBox ' Default As String, optional. Default text to show (Will appear with the ' PasswordChar selected. String character to hide the text entered ' XPos As Long, optional. Horizontal distance between the left border of ' the dialog, and the left border of the screen ' YPos As Long, optional. Vertical distance between the upper border of ' the dialog, and the upper border of the sreen ' Outputs : Variant. Is pressed Ok, the text entered. If pressed Cancel, False '--------------------------------------------------------------------------------------- Function PassInputBox(Prompt As String, Optional PasswordChar As String, Optional Title As String, Optional Default As String, Optional XPos As Long, Optional YPos As Long) Dim UF 'Store the VBComponent Dim VUF As Object 'Store the userform object Dim Lb As Object 'Label for the Prompt Dim Tb As Object 'TextBox which holds the password Dim BOk As Object Dim BCancel As Object Dim VBAVisible As Boolean 'Store VBE.Mainwindow visible state to restore it Dim I As Integer 'Default Title is the same as InputBox If Len(Title) = 0 Then Title = Application.Name 'Store the visible property of the VBE mainwindow and hide it to prevent screen flashing VBAVisible = Application.VBE.MainWindow.Visible Application.VBE.MainWindow.Visible = False 'Add temporary Userform Set UF = ThisWorkbook.VBProject.VBComponents.Add(3) 'Add the textbox. If no PasswordChar was supplied, the text will appear normally Set Tb = UF.Designer.Controls.Add("Forms.Textbox.1", "TextBox1") With Tb .PasswordChar = PasswordChar .Left = 4.5 .Top = 69.75 .Width = 254.25 .Height = 15.75 .Value = Default End With 'Add the prompt Set Lb = UF.Designer.Controls.Add("Forms.Label.1") With Lb .Caption = Prompt .WordWrap = True .Left = 6.75 .Top = 6.75 .Width = 198 .Height = 54 End With 'Button OK, it is the default button Set BOk = UF.Designer.Controls.Add("Forms.CommandButton.1", "BOk") With BOk .Caption = "OK" .Left = 209.25 .Top = 4.5 .Width = 49.5 .Height = 18 .Default = True End With 'Button Cancel Set BCancel = UF.Designer.Controls.Add("Forms.CommandButton.1", "BCancel") With BCancel .Caption = "Cancel" .Cancel = True .Left = 209.25 .Top = 27 .Width = 49.5 .Height = 18 End With 'Add code to the Userform module With UF.CodeModule I = .CountOfLines 'MyText is a variant which will hold the answer the user pressed .InsertLines I + 0, "Public MyText as Variant" 'Pressed Cancel, so assign False to MyText .InsertLines I + 1, "Private Sub BCancel_Click()" .InsertLines I + 2, " MyText = False: Me.Hide" .InsertLines I + 3, "End Sub" 'Pressed Ok, so assign the value of TextBox1 to MyText .InsertLines I + 4, "Private Sub BOk_Click()" .InsertLines I + 5, " MyText = TextBox1.Value: Me.Hide" .InsertLines I + 6, "End Sub" 'Closing the form using "X", so assign False to MyText .InsertLines I + 7, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)" .InsertLines I + 8, " If CloseMode = 0 Then Cancel = True: MyText = False: Me.Hide" .InsertLines I + 9, "End Sub" End With 'Properties for the userform With UF .Properties("Caption") = Title .Properties("Width") = 273 .Properties("Height") = 108.75 'Center on screen or show in a specific position If XPos > 0 Or YPos > 0 Then .Properties("StartUpPosition") = 0 .Properties("Left") = XPos .Properties("Top") = YPos Else .Properties("StartUpPosition") = 1 End If End With 'Include the UF in the Userforms collection Set VUF = VBA.UserForms.Add(UF.Name) 'Show the Userform VUF.Show 'Pass the result to this function PassInputBox = VUF.MyText 'Remove the VBcomponet ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=UF 'Restore the VBE Mainwindow Application.VBE.MainWindow.Visible = VBAVisible End Function وبعدين في موديول المصنف Workbook ضع الكود الخاص بك مع بعض التعديل في الأسطر Private Sub Workbook_BeforeClose(Cancel As Boolean) If [IK41421] >= 2 Then GoTo 1 [IK41421] = [IK41421] + 1 1: ThisWorkbook.Save End Sub Private Sub Workbook_Open() Dim ANS As Variant Dim App As PwdInputBox Set App = New PwdInputBox On Error Resume Next Sheets("Sheet1").Select If [IK41421] >= 2 Then Dim pwd As String: pwd = "123456" Cells(Rows.Count, Columns.Count).Activate ANS = App.PassInputBox("Enter you password", "*", "Password") If ANS <> pwd Then Sheets("Sheet1").Select Workbook.Update MsgBox " Rong Active ! Rong S.N Please tray Agien Later", 0, "You Can,t Enter Sorry " ThisWorkbook.Save ThisWorkbook.Close Else Range("IK41421").Value = 0 Range("A1").Select End If End If End Sub جرب وشوف

فقط غير كلمة Worksheet_Change إلى Worksheet_SelectionChange

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

جرب الملف التالي عله يفي بالغرض InputBox Password Mask.rar

قم بضبط المعادلة VLOOKUP وذلك بإضافة الدالة IFERROR قبل اسم الدالة وفي نهاية المعادلة فاصلة ثم أقواس تنصيص مرتين ثم أغلق القوس لتكون المعادلة بهذا الشكل =IFERROR(VLOOKUP(C11,'C:\Users\Mariam\Desktop\New folder\[find.xls]اكواد الاصناف'!$A$1:$IV$65536,3,0),"") المعادلة كمثال فقط للتطبيق عليها

أين المرفق أخي الكريم؟ قم بضغط الملف ثم رفعه