أبو حنــــين

السلام عليكم هل بهذا الشكل المصنف1.rar

السلام عليكم استعمل هذه الدالة في الخلية B1 ثم اسحبها للاسفل ="+966"&MID(A1;2;LEN(A1))

السلام عليكم هذا مثال يمكنك تعديله حسب ما تريد مثال.rar

مرحبا في غياب مثال يوضح المطلوب يصعب التكهن بالنتيجة جرب هذه الدالة المستحدثة بحيث تقوم بنسخ هذه الدالة في موديل و تكتب في خلية ما : =xNember(A1) حيث A1 هي الخلية التي تحتوي على الرقم المعني بالحساب Function xNember(My_Value As Double) Dim Result Select Case My_Value Case 1 To 1999000: Result = My_Value * 0.25 Case 2000000 To 3500000: Result = My_Value * 0.5 Case Is > 3500000: Result = (My_Value - 3500000) * 0.01 + (3500000) * 0.5 End Select xNember = Result End Function

استعمل هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = Range("C1").Address Then _ Range("A1:B" & ActiveSheet.UsedRange.Rows.Count).Copy Sheets(Range("C1").Text).Range("A1") End Sub

السلام عليكم الكود لا يوضع في موديل بل يوضع في الحدث Workbook_Open

جرب هذا الكود لانه ليس لديا أوفيس 2003 لتجربته Private Sub Workbook_Open() If Application.Version > "11" Then MsgBox "هذا الرنامج لا يعمل إلا على النسخة 2003", vbInformation + vbOKOnly, "خطأ" Application.DisplayAlerts = False With ThisWorkbook .Saved = True .Close End With End If End Sub

لم اقم بسحب الخلايا للاسفل في الجدول 2 HM66-.rar

مرحبا هل بهذا الشكل HM55-.rar

السلام عليكم جرب هذا الكود Sub iConvert() Dim C As Range For Each C In Range("A1:A89") With C .NumberFormat = "#,##0.00" .Value = StrReverse(WorksheetFunction.Substitute(.Value, " ", "")) End With Next End Sub

السلام عليكم من خصائص الكمبوبكس اختر : Style = 2 - fmSyleDropDownList

مرحبا هناك برنامج اسمه : Passware Kit Enterprise 10.0 يقوم بفك الحماية و استخراج كلمة المرور

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

السلام عليكم ربما هذا يفيدك Sub sCoopy() Application.ScreenUpdating = False Dim C As Range, J As Range Range("D6:D13").ClearContents For Each C In Range("C6:C13") For Each J In Range("J6:J13") If J Like C & "*" Then C.Offset(, 1).Value = J.Value Next Next Application.ScreenUpdating = True End Sub

للذهاب الى ورقة نكتب Sheets("codes").Select أو Sheets("invoice").Select

السلام عليكم يصبح الكود بهذا الشكل Private Sub Worksheet_Change(ByVal Target As Range) If Not Target.Address = Range("C2").Address Then Exit Sub '''''''''''''''''' Dim Lr As Long, i As Long, R As Long, x As Byte Dim txt Range("A6:F" & Cells(Rows.Count, "A").End(xlUp).Row).ClearContents Application.ScreenUpdating = False txt = Trim(Target) If Len(txt) < 3 Then Exit Sub With Sheets("Data") Lr = .Cells(.Rows.Count, "A").End(xlUp).Row For i = Lr To 2 Step -1 For x = 1 To 8 If txt = CStr(.Cells(i, x)) Then Cells(R + 6, "A").Resize(1, 3).Value = .Cells(i, "A").Resize(1, 3).Value Cells(R + 6, "D").Resize(1, 2).Value = .Cells(i, "E").Resize(1, 2).Value Cells(R + 6, "F").Value = .Cells(i, "H").Value R = R + 1 End If Next Next End With Application.ScreenUpdating = True End Sub

السلام علكم دائما تصعب الاجابة في غياب المرفق ، لكن هذا مثال على الدخول باسم مستخدم و كلمة مرور اسم المستخدم : مستخدم 1 كلمة المرور : 123 مثال.rar

مرحبا معنى ذلك ان الملف لم يتم غلقه في المرة الاولى لذلك تأتيك رسالة مفادها ان الملف مفتوح و الخطأ في السطر Application.Visible = False عند الخروج من الملف يجب استعمال ThisWorkbook.Close او Application.Quit

أخي أحمد جزاكم الله خيرا

السلام عليكم يصبح الكود هكذا Sub PullUniques() Application.ScreenUpdating = False Dim rngCell As Range For Each rngCell In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row) If WorksheetFunction.CountIf(Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row), rngCell) = 0 Then Range("C" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next For Each rngCell In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row) If WorksheetFunction.CountIf(Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row), rngCell) = 0 Then Range("D" & Rows.Count).End(xlUp).Offset(1) = rngCell End If Next Application.ScreenUpdating = True End Sub

السلام عليكم بعد اذن اخي طلعت هذا مثال يمكن من خلاله تحديد ايام بدأ التنبيه 4.rar

السلام عليكم جرب المرفق اضافة تعليق على خلي 2.rar

نورت المنتدي أخي ياسر ، غبت طويلا ان شاء الله خير الحمد لله على العودة

السلام عليكم اخي محمد وضعت كود لمنع التكرار ، جربه و اخبرني منع تكرار الصنف في 22الفاتورة.rar

السلام عليكم الملف بعد التعديل فاتورة ديناميكية 5.rar