عبدالله باقشير

السلام عليكم انا لاادري عن ما في الكود من اسطر لكن الغاية اضافة هذا السطر Cancel = True جرب التالي Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Set Dop_A = TextBox1 Cancel = True UserForm2.Show End Sub تحياتي

سؤال في محله اذا كانت الخلية فارغة ستكون قيمة i صفر لهذا لن يعمل السطر المشروط لو تجاوزت هذا الشرط سيكون خطأ في الكود تحياتي

السلام عليكم جرب الكود التالي Sub kh_split() Dim sp Dim m As String Dim i As Integer m = Range("d5").Formula m = Replace(m, "=", "") sp = split(m, "+") i = UBound(sp) + 1 If i Then Range("G5").Resize(1, i).Value = sp End If End Sub تحياتي

السلام عليكم يمكن الوصول الى مواضيع اي عضو بوضع زر الماوس على اسمه واختيار كتاباتي وممكن اختيار المواضيع او المشاركات مثلا هذه مواضيع الاستاذ جمال http://www.officena.net/ib/index.php?app=core&module=search&do=user_activity&search_app=forums&mid=68381&sid=84565fa0a04c1fd51a42420c7e32d59c&search_app_filters[forums][searchInKey]=&userMode=title تحياتي

السلام عليكم جرب الكود التالي اضغط (ctrl+a) Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If KeyAscii = 1 Then MsgBox KeyAscii End Sub

جزاكم الله خيرا المرفق اوفيس 2003 نقل البيانات مباشرة.rar

السلام عليكم Sub Macro1() Dim Dr As Double Dim R As Long Dim MyColmn As Integer With Range("C9:N9") Range(.Cells, .Cells.End(xlDown)).ClearContents End With With ورقة1 For R = 6 To .Cells(.Rows.Count, 1).End(xlUp).Row Dr = Val(.Cells(R, "B")) Select Case Dr Case 0 To 49: MyColmn = 3 Case 50 To 64: MyColmn = 5 Case 65 To 74: MyColmn = 7 Case 75 To 84: MyColmn = 9 Case 85 To 99: MyColmn = 11 Case Else: MyColmn = 13 End Select Cells(Rows.Count, MyColmn).End(xlUp).Offset(1, 0).Resize(1, 2).Value = .Cells(R, "A").Resize(1, 2).Value Next End With End Sub المرفق 2010 نقل البيانات مباشرة.rar

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم و رحمة الله وبركاته جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم و رحمة الله وبركاته جزاكم الله خيرا تقبلوا تحياتي وشكري

وعليكم السلام ورحمة الله وبركاته جزاكم الله خيرا تقبلوا تحياتي وشكري

شاهد المرفق 2010 معادلة جمع معرفة جديدة.rar

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

السلام عليكم ما دمت ما زلت تعتقد ان المعادلة المعمولة بالكود ستحل مشكلتك تم عمل معادلة الصفيف kh_SumIf اضغط F2 لتحرير الصيغة ثم اضغط CTRL+SHIFT+ENTER بامكانية استخدام شرط او اكثر بحد اقصي 254 شرطا Option Explicit '============================================= '============================================= Function kh_SumIf(SumRange As Range, ParamArray Condition1() As Variant) As Double Dim Sm As Double Dim x As Integer, xx As Integer, xxx As Integer Dim iCont As Long, i As Long xx = UBound(Condition1) If xx = -1 Then GoTo kh_Err iCont = SumRange.Rows.Count For i = 1 To iCont xxx = 1 For x = 0 To xx xxx = xxx * IIf(CBool(Condition1(x)(i, 1)), 1, 0) Next If xxx Then Sm = Sm + Val(SumRange.Cells(i, 1)) Next kh_SumIf = Sm kh_Err: End Function جربها تحياتي

السلام عليكم ورحمة الله وبركاته يسعدني ان اتقدم بالتهنئة لاخي الحبيب ضاحي الغريب بمناسبة ترقيته الى خبير معتمد واقول له الف مليوووووووووووووووووووووون مبروك والى الامام دوما تقبلوا تحياتي وشكري .

السلام عليكم استخدم المعادلة التالية في اي خلية تريدها =MATCH(D6;list;0) تحياتي

السلام عليكم اضف هذا السطر بداية الكود UserForm_Activate ComboBox1.MatchRequired = True او غير هذه الخاصية اثناء التصميم من خصائص ComboBox1 تحياتي

استبدل كود اظهار الفورم في الملف الذي في المشاركة 11 الكود في موديل الورقة Sheet1 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = Range("F9").Address Then Cancel = True UserForm1.Show End If End Sub

السلام عليكم اذا تقصد حفظ باسم استخدم هذا الكود في موديل ThisWorkbook Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI Then Cancel = True End Sub تحياتي

السلام عليكم اضف هذا السطر بداية الكود UserForm_Activate ComboBox1.Style = 2 او غير هذه الخاصية اثناء التصميم من خصائص ComboBox1 تحياتي

السلام عليكم المعادلة المطلوبة بالكود لن تحل مشكلة البطىء لان البطىء متعلق بحجم قاعدة البيانات وعدد المعادلات المستخدمة للجمع في الملف والله اعلم

السلام عليكم استبدل هذا الكود Sub kh_AddSheetsInNewBook() Dim Sh As Worksheet Dim i As Long, Last As Long Dim NamSheet As String, txt As String '============================ On Error Resume Next With Feuil1 .AutoFilterMode = False Last = .Cells(.Rows.Count, "B").End(xlUp).Row If Last < 10 Then GoTo kh_ExT Set ColumnFilter = Range("H9:H" & Last) Set Rng = Range("B9:AZ" & Last) End With ''''''''''''''''''''''' kh_SetNewPath ''''''''''''''''''''''' kh_Application False ''''''''''''''''''''''' With ColumnFilter For i = 2 To .Rows.Count NamSheet = Trim(.Cells(i, 1)) If Len(NamSheet) Then NamSheet = kh_Replace(NamSheet) ''''''''''''''''''''' If InStr(1, "#" & txt, "#" & NamSheet & "#", vbTextCompare) = 0 Then txt = txt & NamSheet & "#" Set Sh = Workbooks.Add(xlWBATWorksheet).Worksheets(1) Sh.Name = NamSheet Sh.DisplayRightToLeft = True ''''''''''''''''''''''' kh_PastRngInNewBook Sh, CStr(.Cells(i, 1)) ''''''''''''''''''''''' End If End If Next End With ''''''''''''''''''''''' kh_ExT: With Rng.Worksheet .Activate .AutoFilterMode = False End With ''''''''''''''''''''''' kh_Application True ''''''''''''''''''''''' Set Sh = Nothing Set Rng = Nothing Set ColumnFilter = Nothing On Error GoTo 0 End Sub تحياتي

السلام عليكم هذا احد طلباتك اما بخصوص الطباعة لا تصلح على الفورم بسسب شريط التمرير المرفق 2010 تسجيل الجوازات 2014.rar

السلام عليكم يجب ان يكون الملف book1 مفتوح جرب الكود التالي Sub kh_Start() Dim Cel As Range Dim Adr As String Dim r As Integer, rr As Integer On Error GoTo 1 Adr = [J3] For Each Cel In Range("C6:C12") rr = Val(Cel) If rr Then With Workbooks("Book1").Sheets("Sheet1") With .Range(Adr).Cells(rr, Columns.Count).End(xlToLeft) .Offset(0, 1).Value = Cel.Offset(0, 2).Value End With End With End If Next MsgBox "تم الترحيل بنجاح" 1: End Sub تحياتي