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

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

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

السلام عليكم ياخذ رقم الصفحة من الرقم الذي مكتوب في الزر Sub kh_PageSelect() Dim P As Integer Dim Adr As String On Error GoTo 1 P = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text Adr = ActiveSheet.HPageBreaks(P - 1).Location.Address Range(Adr).Select 1: If Err Then Err.Clear: Range("a2").Select End Sub المرفق 2010 التنقل الى صفحات الطباعة.rar

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

السلام عليكم استخدم الكود التالي في موديل الورقة1 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count <> 1 Then Exit Sub If Target.Column <> 1 Then Exit Sub If Len(Trim(Target)) = 0 Then Exit Sub With ورقة2 .Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Value = Target.Value End With End Sub المرفق2010 المصنف771.rar

السلام عليكم ورحمة الله وبركاته افهم من ذلك انك تريد معادلة موحدة في العمود (V) تضرب المبلغ في سعر العملة حسب ما يكون موقعه من الاعمده (D4, E4 & F4) ضع هذه المعادلة في الخلية V5 واسحبها على باقي العمود =IF(D5;L5;L5*OFFSET($E$35;MATCH(TODAY();$D$36:$D$1009);MATCH(SUM($E5:$F5);$E5:$F5;0)-1;1)) جرب واشعرنا بانتيجة

السلام عليكم باستخدام التصفية المتقدمة المرفق 2003 يانات العاملين1.rar

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

وعليكم السلام حسب ما فهمت الضرب فقط في قيمة الدولار تفضل =L9*OFFSET($E$35;MATCH(TODAY();$D$36:$D$1009);;1) تحياتي

السلام عليكم جرب الكود التالي Private Sub TextBox1_AfterUpdate() Me.TextBox2 = "" With Me.TextBox1 If IsDate(.Value) Then .Value = Format(CDate(.Value), "yyyy/mm/dd") Me.TextBox2 = Format(CDate(.Value) + 30, "yyyy/mm/dd") End If End With End Sub تحياتي

تم استبدال الملف

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

وعليكم السلام تفضل =IF($B4="";"";IFERROR($F4+SUMPRODUCT(($G4:$H4)*OFFSET($G$22:$H$22;MATCH(TODAY();$F$23:$F$1008);0));""))

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

السلام عليكم جزاكم الله خيرا وانعم عليكم بنعيم الدنيا والآخرة يمكنك اضافة السطر التالي في الكود Circles1 (كود اظهار الدوائر) وهو لتعيين خاصية عدم النقل للدائرة المضافة v.Placement = xlFreeFloating الكود بعد اضافة هذا السطر Sub Circles1() Dim C As Range Dim MyRng As Range, v As Shape Dim X As Integer, G As Integer, R As Integer, D As Integer '================================================ Set MyRng = Range("F5:M405") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها '================================================ X = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 For Each C In MyRng If C.Value = "" Then GoTo 1 If (C.Value < 50 Or C.Value = "غائب" Or C.Value = "صفر") Then Set v = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 3, C.Top + 3, C.Width - 6, C.Height - 6) v.Fill.Visible = msoFalse v.Line.ForeColor.SchemeColor = 10 v.Line.Weight = 1.75 v.Placement = xlFreeFloating D = D + 1 End If 1 Next ActiveWindow.Zoom = X Application.ScreenUpdating = True MsgBox "تم إضافة " & D & " دائرة بنجاح", vbMsgBoxRtlReading, "الحمدلله" End Sub الآن في التصفية لن تظهر الدوائر تحياتي

السلام عليكم وهذا التعديل على الكود لاظهار الرسالة المطلوبة Sub SendDataCash1() Dim iRow As Long Dim ws As Worksheet Dim LR As Integer LR = WorksheetFunction.Count(Range("K10:K109")) If LR = 0 Then GoTo 1 If LR <> WorksheetFunction.Count(Range("A10:A109")) Then GoTo 1 Set ws = Worksheets("TRANSACTIONS") iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row Range("A10:U10").Resize(LR).Copy ws.Range("A" & iRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("B10").Select MsgBox "تم الترحيل" Set ws = Nothing Exit Sub 1: MsgBox "((يرجى التأكد من البيانات الغير مكتملة قبل الترحيل))", vbMsgBoxRight + vbMsgBoxRtlReading End Sub وهذا كود آخر بتغيير طريقة الترحيل للافادة Sub SendDataCash2() Dim iRow As Long Dim ws As Worksheet Dim LR As Integer LR = WorksheetFunction.Count(Range("K10:K109")) If LR = 0 Then GoTo 1 If LR <> WorksheetFunction.Count(Range("A10:A109")) Then GoTo 1 Set ws = Worksheets("TRANSACTIONS") iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row With Range("A10:U10").Resize(LR) ws.Range("A" & iRow).Resize(.Rows.Count, .Columns.Count).Value = .Value End With Range("B10").Select MsgBox "تم الترحيل" Set ws = Nothing Exit Sub 1: MsgBox "((يرجى التأكد من البيانات الغير مكتملة قبل الترحيل))", vbMsgBoxRight + vbMsgBoxRtlReading End Sub تحياتي

السلام عليكم مادمت اكملت الشروط بالمعادلات نكمل بالمعادلات اكتب اي حاجة في الخلية K9 ولو حتى فراغ والغاية ان لاتكون فاضية ثم استبدل المعادلة التالية في الخلية K10 واسحبها على باقي العمود =IF(OR(K9="";$B$3="";$D$3="";$F$3="";$J$3="";$E$6="";$G$6="";$K$6="";A10="";B10="";C10="";E10="";F10="";G10="";J10="");"";$K$6-SUM($E$10:E10)) هكذا لن يظهر الرصيد في الخلية الا اذا ظهر في الخلية اعلاه والكود لن يرحل الا الرضائد الظاهرة ان وجدت جرب واشعرني بالنتيجة تحياتي

السلام عليكم هذه المعادلة تعطيك السطر 8 ابتداءا من الصف 23 يعني الصف 30 =MATCH(TODAY();$F$23:$F$31) ادخلها في المعادلة الموجودة في العمود J

السلام عليكم جرب الكود التالي: Sub SendDataCash1() Dim iRow As Long Dim ws As Worksheet Dim LR As Integer LR = WorksheetFunction.Count(Range("K10:K109")) If LR = 0 Then Exit Sub Set ws = Worksheets("TRANSACTIONS") iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row Range("A10:U10").Resize(LR).Copy ws.Range("A" & iRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("B10").Select MsgBox "تم الترحيل" Set ws = Nothing End Sub واشعرنا بالنتيجة تحياتي

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

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

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

السلام عليكم استخدم كود حذف الدوائر RemoveCircles1 بداية كود التصفية تحياتي

السلام عليكم في الكود UserForm_Activate غير السطر wColmn = Join(Split(Trim(wColmn)), ",") الى السطر wColmn = Join(Split(Trim(wColmn)), ";") تحياتي

الحمد لله رب العالمين تقبلوا تحياتي وشكري السلام عليكم