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

السلام عليكم السبب العمود بي فيه معادلات استخدم الكود السابق Sub print_m() Dim A Dim TT As Long TT = 6 Do Until Cells(TT, "B").Value = "" TT = TT + 1 Loop Range(Cells(1, "B"), Cells(TT - 1, "O")).PrintPreview A = MsgBox("هل تود الطباعة بعد المعاينة ؟", vbYesNo + vbQuestion, "طباعة") If A = vbYes Then With ActiveSheet .PrintOut End With End If End Sub

جرب هذا الكود Sub print_m() Dim A Dim TT As Long TT = Cells(Rows.Count, "B").End(xlUp).Row Range(Cells(5, "B"), Cells(TT, "F")).PrintPreview A = MsgBox("هل تود الطباعة بعد المعاينة ؟", vbYesNo + vbQuestion, "طباعة") If A = vbYes Then With ActiveSheet .PrintOut End With End If End Sub تحياتي

جزاكم الله خيرا

السلام عليكم =IF(R24>R40;R24*2.5%;R40*2.5%) الزكاة.rar

غير في هذا السطر العمود الذي تريد If WorksheetFunction.CountIf(.Range("C2:C" & Last), CStr(.Cells(R, "c"))) > 1 Then .Cells(R, "A").Resize(1, 7) من العمود a الى g سبعة اعمدة غير العدد سبعة الى اي عدد تريد اذا غيرت الى 20 سيكون من العمود a الى t تحياتي

Private Sub CommandButton1_Click() Me.PrintForm End Sub

جزاكم الله خيرا

جرب هذه =MIN(OFFSET($A$2:$A$59;MATCH(D18;$A$2:$A$59;0);0))

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

السلام عليكم Option Explicit Sub kh_mKRR() Dim c As Integer Dim Last As Long, R As Long, LR As Long ''''''''''''''''''''''''''''' Last = ورقة1.Cells(Rows.Count, "A").End(xlUp).Row ''''''''''''''''''''''''''''' Range("A2").Resize(Cells(Rows.Count, "A").End(xlUp).Row).EntireRow.Delete ''''''''''''''''''''''''''''' Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ''''''''''''''''''''''''''''' With ورقة1 For R = 2 To Last If WorksheetFunction.CountIf(.Range("C2:C" & Last), CStr(.Cells(R, "c"))) > 1 Then LR = Cells(Rows.Count, "A").End(xlUp).Row + 1 .Cells(R, "A").Resize(1, 7).Copy Cells(LR, "A") End If Next End With ''''''''''''''''''''''''''''' Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic ''''''''''''''''''''''''''''' End Sub ترحيل الارقام المكررة.rar

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

Private Sub CommandButton1_Click() Me.PrintForm End Sub

السلام عليكم اضف هذا الكود الى الفورم Private Sub UserForm_Initialize() Me.RightToLeft = True End Sub او اثناء التصميم من خصائص الفورم عين الخاصية RightToLeft الى True

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

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

جزاكم الله خيرا

جزاكم الله خيرا

استبدل كود البحث بهذا Private Sub ButtonFind_Click() Dim MyValue Dim MyAr() As String Dim ib As Boolean Dim MyRow As Long, RR As Long Dim C As Integer '------------------------- If MyColmnFind = 0 Then Exit Sub '------------------------- If Me.ListFind.ListCount Then Me.ListFind.Clear '------------------------- sRow = "" Me.LblSum = 0 '------------------------- With dRng For MyRow = 1 To .Rows.Count ib = dTest(.Cells(MyRow, MyColmnFind)) '======================= If ib Then sRow = sRow & MyRow & " " RR = RR + 1 ReDim Preserve MyAr(1 To ContColmn, 1 To RR) For C = 1 To ContColmn If IsDate(.Cells(MyRow, C)) Then MyValue = Format(.Cells(MyRow, C).Value2, DateFormt) _ Else MyValue = Format(.Cells(MyRow, C).Value2, "#,##0.00") MyAr(C, RR) = MyValue If C = ContColmn Then Me.LblSum = Val(Me.LblSum) + Val(.Cells(MyRow, C)) Next End If Next End With '========================= Me.LblSum = Format(Me.LblSum, "#,##0.00") Me.LabelCont.Caption = RR Me.FrameValue.Visible = CBool(RR) If RR Then Me.ListFind.Column = MyAr Me.ListFind.ListIndex = 0 Else MsgBox "No Data Result...Sorry Oryx", vbMsgBoxRight, "Sorry..Oryx" End If Erase MyAr End Sub

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

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

شاهد المرفق 2003 Purchase.rar

جزاكم الله خيرا

جزاكم الله خيرا

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

السلام عليكم الاخ الحبيب ضاحي الغريب .....حفظكم الله جزاكم الله خيرا وبارك فيكم استمر وفقك الله ليكون مرجع للسائل بامور الفورم تقبلوا تحياتي وشكري