أ / محمد صالح

جميعا بإذن الله

الشكر لله الذي وفقنا لهذا

يمكنك استعمال هذا الكود للتصفية أولا ثم النسخ ثم الحذف Sub copy_filtered_data() If Evaluate("=COUNTIF(I:I,""جاهز"")") > 0 Then Application.ScreenUpdating = 0 Dim lr1 As Long, lr2 As Long lr1 = Sheet1.Cells(Rows.Count, 1).End(3).Row lr2 = Sheet2.Cells(Rows.Count, 1).End(3).Row + 1 Sheet1.Range("$A$1:$I$" & lr1).AutoFilter Field:=9, Criteria1:="جاهز" Sheet1.Range("a2:i" & lr1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("A" & lr2) Sheet1.Range("a2:i" & lr1).SpecialCells(xlCellTypeVisible).EntireRow.Delete Sheet1.Range("$A$1:$I$" & lr1).AutoFilter Application.ScreenUpdating = 1 MsgBox "done by mr-mas.com" Else MsgBox "لا يوجد صفوف جاهزة لترحيلها" End If End Sub وهذا ملفك بعد وضع الكود وتغيير الامتداد (لأن معظم الأوقات يكون صاحب الاستفسار لا يعرف كيفية التعامل مع أساسيات الأكواد) بالتوفيق نسخ البيانات بعد الفلتر.xlsb

يمكنك استعمال هذا الكود وهو نفس الكود ولكن بتعديلات بسيطة Sub test() Dim ws As Worksheet, lr As Integer, lr2 As Integer Application.ScreenUpdating = False Sheets("البيان المجمع").Range("a4:e10000").ClearContents For Each ws In ThisWorkbook.Worksheets If ws.Name <> "البيان المجمع" And ws.Name <> "ملاحظات" Then With ws .Activate lr = .Cells(Rows.Count, 1).End(xlUp).Row lr2 = Sheets("البيان المجمع").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("البيان المجمع").Range("a" & lr2 & ":e" & lr2 + lr - 4).Value = .Range("a4:e" & lr).Value End With End If Next Sheets("البيان المجمع").Activate: Range("a1").Select Application.ScreenUpdating = True End Sub بالتوفيق

يفضل إرفاق ملف ولكن يمكنك تجربة هذه المعادلة حسب فهمي للمطلوب =IF(C1>=0.3,C1*100-5,0) حيث أن c1 هي الخلية التي بها النسبة وهي تنتج من قسمة عدد الأفكار المقدمة على العدد الكلي وتنسيق الخلية كنسبة مئوية بالتوفيق

الملف لا يحمل أي محاولة من حضرتك في تنفيذ المطلوب كما أن مطلوبك هكدا عمل برنامج متكامل يفضل أن تبدأ حضرتك في التنفيذ وإذا تعثرت في نقطة أو اثنتين يمكن عرضها في موضوع جديد مع شرح المطلوب بالتفصيل بالتوفيق

يمكنك الغاء تثبيت البرنامج من لوحة التحكم وتنزيل ميكروسوفت اوفيس 2019 مثلا بالتوفيق

يا ريت مزيد من التفاصيل حيث أن wps أونلاين أو أي أوفيس أونلاين لا يدعم أكواد الماكرو كما أنه توجد خاصية الحفظ التلقائي وتوجد خاصية التاريخ أو الإصدارات السابقة

إذا استخدمت البحث ستجد الكثير فيما يخص عرض الصور في الشيت أو النموذج هذه بعض النتائج https://www.officena.net/ib/search/?q=الصور الشيت&type=forums_topic&nodes=135&updated_after=any&sortby=relevancy&search_and_or=and بالتوفيق

جميعا يا رب العالمين

نظام الفاصلة في جهازك هو الفاصلة المنقوطة لذلك ضع الفاصلة المنقوطة بدل الفاصلة وهكذا مع أي معادلات تنسخها من المنتدى بالتوفيق

جميعا بإذن الله

يمكنك استعمال هذا الكود في حدث الضغط على زر إدخال Private Sub CommandButton1_Click() Sheets(1).Activate lrow = Range("e" & Rows.Count).End(xlUp).Row + 1 If WorksheetFunction.CountIfs(Range("D2:D" & lrow), ComboBox1.Value, Range("E2:E" & lrow), ComboBox2.Value) = 0 Then Range("d" & lrow).Value = ComboBox1.Value Range("E" & lrow).Value = ComboBox2.Value ComboBox1.Value = "" ComboBox2.Value = "" Else MsgBox "إدخال مكرر" End If End Sub بالتوفيق

عليكم السلام إذا قمت بتسجيل ماكرو ستحصل على الكود وبقليل من التعديلات تجعل الكود متغيرا في صف الننهاية الذي رمزه LR هذا هو الكود Sub girlsfirst() Dim sh As Worksheet, lr As Long Set sh = ActiveWorkbook.Worksheets("sheet") lr = sh.Cells(Rows.Count, 3).End(3).Row With sh.Sort .SortFields.Clear .SortFields.Add2 Key:=Range("L10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add2 Key:=Range("C10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("B7:X" & lr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub Sub boysfirst() Dim sh As Worksheet, lr As Long Set sh = ActiveWorkbook.Worksheets("sheet") lr = sh.Cells(Rows.Count, 3).End(3).Row With sh.Sort .SortFields.Clear .SortFields.Add2 Key:=Range("L10"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .SortFields.Add2 Key:=Range("C10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("B7:X" & lr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub بالتوفيق

جميعا بإذن الله

إحدى الفوائد اختصار المعادلات وسهولة تسمية النطاق باسم يعبر عن مضمونها مثلا قائمة الأصناف موجودة في sheet1!a5:a40 فيمكن تسمية هذا النطاق products وبدلا من كتابتة هذا النطاق في المعادلة نكتب كلمة products بالتوفيق

كما أخبرتك سابقا نطاقات مسماة

ربما تكون نطاقات مسماة named ranges الموجودة في تبويب الصيغ formulas ضمن إدارة الأسماء name manager لو أرفقت الملف الذي به هذه المعادلة ربما نصل لليقين بالتوفيق

جميعا بإذن الله

المتاح أن تضيف النص الذي في textbox قبل التصدير pdf لكن العكس يلزمك برامج تحرير بي دي اف وتدعم العمل عليها من خلال vba أو من خلال سطر الأوامر cmd بالتوفيق

آمين ولك بمثل ما دعوت وزيادة

أخي الكريم يفضل ذكر كل التفاصيل المتاحة لديك حتي يتم الوصول للحل المطلوب بمنتهى السهولة وعلى مرة واحدة لكن تجزئة المعطيات تؤدي إلى حلول غير مطلوبة حسب فهمي للمطلوب أنك تريد * وضع تسلسل يبدأ من الصف الثاني * إلى آخر صف مكتوب فيه في العمود b وليس إلى 10 * والكود يتم تطبيقه من الأكسس على كائن الشيت النشط يمكنك استعمال هذا الكود Dim I As Integer For I = 2 To .range("b" & .rows.count).end(3).row .Range("A" & I).Value = I-1 Next I بالتوفيق

يمكنك استعمال هذا التعديل Dim I As Integer For I = 2 To 11 Range("A" & I).Value = I-1 Next I بالتوفيق

يمكنك استعمال هذا الكود في حدث عند تغيير التحديد Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 5 Or Target.Column = 7 Then Range("ad2").Value = Target.Value End If End Sub وهذا ملفك بعد إضافة الكود وتغيير الامتداد بالتوفيق Select.xlsb

عليكم السلام ورحمة الله وبركاته * بالنسبة للمطلوب الأول لا يمكن استخدام كالندر داخل الخلايا ممكن في يوزرفورم ولكن يمكنك جعل تنسيق خلية التاريخ dddd dd mmmm yyyy سيظهر اسم اليوم واسم الشهر مع التاريخ ويمكنك الاستغناء عن عمود اليوم * وبالنسبة لكتابة جميع تواريخ الشهر يمكنك في الخلية B5 كتابة المعادلة التالية =B4+1 مع نسخ المعادلة لأسفل * وبالنسبة لموضوع منع التكرار يمكن استعمال التنسيق الشرطي وتلوين الصفين المكررين وهذا ملفك بعد تنفيذ مقترحاتي بالتوفيق برنامج حجز قاعات 2021.xlsx