نجوم المشاركات

السلام عليكم و رحمة الله استخدم المعادلة التالية =IF(COUNTIFS($B$6:B6;B6;$F$6:F6;F6;$K$6:K6;K6)>1;"سبق وتم إدخاله";"")

بارك الله في عمرك يا اخي الكريم اشكرك من كل قلبي وجزاك الله عمن أخدمهم بهذا البرنامج ، لك اجرهم كصدقة جارية ان شاء الله

تفضل استاد @محمد مصطفى درويش Public Sub SAVE_PDF() Dim SH As Worksheet Dim WSdest As String Dim wsName As Variant Const cstrDel As String = "," Application.ScreenUpdating = False For Each SH In Worksheets If SH.Index >= 8 Then WSdest = WSdest & SH.Name & cstrDel End If Next SH ' 'PDF اسم ملف wsName = "البطاقات" Worksheets(Split(Left(WSdest, Len(WSdest) - 1), cstrDel)).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=ThisWorkbook.Path & "\" & wsName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False Sheet1.Select Application.ScreenUpdating = True MsgBox "تم حفظ" & " " & Application.Sheets.Count - 7 & " " & "بطاقة ", Exclamation, "officena" End Sub ملف الطالب 2.rar

بعد اذن ا/ ابراهيم الحداد تفضل اخي ... لمكرر بشروط ثلاث (1).xlsx

تفضل استاد @محمد مصطفى درويش يمكنك استخدام الكود التالي مع الاخد بالاعتبار ان وقت تنفيد الكود من الممكن ان يصل الى دقيقتين او اكثر بسبب العدد الكبير للشيتات المحفوظة Sub Save_PDF() Dim i As Byte Path = ThisWorkbook.Path & "\" temps = Timer Application.ScreenUpdating = False Dim weekSheet As Worksheet For i = 8 To Worksheets.Count With Sheets(i).Select Set weekSheet = ActiveSheet weekSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & weekSheet.Name & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End With Next Sheet1.Activate Application.ScreenUpdating = True MsgBox "تم حفظ" & " " & Application.Sheets.Count - 7 & " " & "بطاقة " & "-" & "تم تنفيد الكود في: " & Format(Timer - temps, "0.0000") & "ثانية", Exclamation, "Officena" End Sub ملف الطالب.rar

اعرض الملف برنامج العطاء للتقسيط المجاني برنامج العطاء للتقسيط القروض و الاقساط اسم البرنامج : برنامج العطاء للتقسيط نسخة البرنامج : النسخة 4 متطلبات البرنامج : برنامج اوفيس اكسس 2003 صلاحية البرنامج : برنامج مجاني مفتوح يتم تسجيل الاقساط للعميل واظهار المسدد والمتبقي على العميل كذلك طباعة تقرير سواء باسم العميل لوحدة او برقم هوية العميل في حالة وجود عدد من الملفات لهذا العميل وكذلك طباعة كمبيالة للعميل - عقد مبايعة - مخالصة والباقي تقدر تكتشفة بالبرنامج البرنامج يتم استعمالة في تقسيط بطاقات سوا وغيرها لمن يعملون في التقسيط نريد ارائكم واقترحتكم ومشاركاتكم بعد تجربة البرنامج في هذه الصفحة رابط البرنامجالبرنامج من هنا كما تم رفعة على مكتبة اوفيسنا صاحب الملف waleed907 تمت الاضافه 21 سبت, 2015 الاقسام قسم الأكسيس  

إضافة إلى إجابة الأستاذ إبراهيم لنفرض أن ناتج الصيغة فراغ مثال =IF(ورقة1!A2="";"";ورقة1!A2) فإن COUNTIF لن تجد الصفر وستعد الفراغ في هذه الحالة يمكن استخدام =SUM((LEN(A1:A444)>9)*1) مع الضغط على كنترول + شفت + انتر . Shift+Ctrl+Enter 454545.xlsx

The desired output is still not clear. Generally try the following code and modify to suit your output Sub Test() Const SROW As Long = 15 Dim ws As Worksheet, rng As Range, iRow As Long, c As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.ActiveSheet With ws .Range("A" & SROW).CurrentRegion.Clear .Range("A1").CurrentRegion.Copy .Range("A" & SROW) Set rng = .Range("A" & SROW).CurrentRegion For iRow = SROW + 1 To rng.Rows.Count + SROW - 1 For c = 8 To 13 If .Cells(iRow, c).Value >= .Cells(iRow, "N").Value And .Cells(iRow, c).Value <= .Cells(iRow, "O").Value Then Else .Cells(iRow, c).ClearContents .Cells(iRow, c).Offset(, -6).ClearContents End If Next c Next iRow End With Application.ScreenUpdating = True End Sub

بارك الله في علمك وعملك ووفقك الله أخي الكريم ، اعذرني أخي الكريم لعلي لم أفهم قصدك بردك السابق (هل تريد حفظ الشيتات بصيغة Pdf في مكان معين وطباعتها في نفس الوقت او الحفظ فقط) انما كل ما اريده ان يقوم الكود بحفظها بهذا الشكل ان أمكن شاكرا تعبك معي في هذه الايام الفضيلة كما في الملف المرفق التالي بطاقات الصف الثاني.pdf

وعليكم السلام ورحمة الله وبركاته 🙂 تفضل أخي جمال .. [order_code] & "." & [report_No] & "." & Format([Received_date];"mm") & "." & Format([Received_date];"yy")

السلام عليكم و رحمة الله اجعل الدالة هكذا =COUNTIF(A1:A230;"<>"&"0")

جعله الله فى ميزان حسناتك

جعله الله فى ميزان حسناتك

آخر المواضيع المثبتة برامج مصممه على الأكسيل ListView Right to Left الدرس الثاني قائمة شقية للاصناف الكثيرة والمتشابهة Pop-up form in Excel Userform UserForm interactive سلسلة دروس الفورم التفاعلي وبتاء قاعدة البيانات

وعليكم السلام ورحمة الله تعالى وبركاته اليك حل بديل بالاكواد اول خطوة قم بتسمية نطاق عمود التصنيف بالشكل التالي =OFFSET(التعريف!$E$3;;;COUNTA(التعريف!$E:$E)-1) 2) وقم باظافة عنصر Combobox في اول خلية للقائمة المنسدلة G3 3) ضع هدا الكود في حدث شيت صفحة الادخال Dim F(), MH, Rng Private Sub ComboBox1_Change() Dim MH() MH = Application.Transpose([liste]) Me.ComboBox1.List = MH If Me.ComboBox1.ListIndex = -1 And IsError(Application.Match(Me.ComboBox1, MH, 0)) Then Me.ComboBox1.List = Filter(MH, Me.ComboBox1.Text, True, vbTextCompare) Me.ComboBox1.DropDown End If ActiveCell.Value = Me.ComboBox1 If ComboBox1.Value <> "" Then ComboBox1.BackColor = RGB(255, 255, 255) Else ComboBox1.BackColor = &HFFFF00 End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim lr As Long Dim sh1 As Worksheet: Set sh1 = Worksheets("صفحة الادخال") Dim sh2 As Worksheet: Set sh2 = Worksheets("التعريف") lr = sh1.Range("A" & Rows.Count).End(xlUp).Row Set wsdata = Range("G3:G" & lr) If Not Intersect(wsdata, Target) Is Nothing And Target.Count = 1 Then If MH <> "" Then If IsError(Application.Match(Range(MH), F, 0)) Then Range(MH) = "" F = Application.Transpose(sh2.Range("Liste")) Me.ComboBox1.Height = Target.Height + 4 Me.ComboBox1.Width = Target.Width Me.ComboBox1.Top = Target.Top Me.ComboBox1.Left = Target.Left Me.ComboBox1 = Target Me.ComboBox1.Visible = True Me.ComboBox1.Activate MH = Target.Address Else Me.ComboBox1.Visible = False End If End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Set Rng = ActiveCell If KeyCode = 13 Then If IsError(Application.Match(Rng, F, 0)) Then Rng = "" Rng.Offset(1).Select End If End Sub Private Sub ComboBox1_DropButtonClick() lr = Worksheets("التعريف").Cells(Rows.Count, 5).End(xlUp).Row ComboBox1.List = Sheet2.Range("E2:E" & lr).Value End Sub Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If Not iGblInhibitTextBoxEvents Then ComboBox1.Value = "" End If End Sub 3) دوبل كليك على combobox وابحث باي حرف في اي مكان في السطر . حركة الصندوق.xlsb