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

بارك الله فيك أخي الكريم عبد السلام وجزاك الله خيراً لجعل الكود مرن ويعمل لأي مستخدم بدون التعديل فيه ، لا يجب وضع المسار لسطح المكتب بهذا الشكل .. جرب الكود التالي Sub Export_PDF_in_most() Dim Str As String Str = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" Application.ScreenUpdating = False ActiveWindow.DisplayWorkbookTabs = True Sheets(Array("sheet2")).Select ActiveSheet.ExportAsFixedFormat xlTypePDF, Str & "\ تاريخ " & Sheet2.Range("A1") & ".PDF" Worksheets("sheet2").Select ActiveWindow.DisplayWorkbookTabs = False Application.ScreenUpdating = True End Sub

Application.ScreenUpdating = False ActiveWindow.DisplayWorkbookTabs = True Sheets(Array("sheet2")).Select 'محتاج تغيير مسار الحفظ الى سطح المكتب وليس الى نفس مكان تواجد الملف ActiveSheet.ExportAsFixedFormat xlTypePDF, "C:\Users\new\Desktop\nam" _ & "\ تاريخ " & n & Sheet2.Range("a1") & ".PDF" Worksheets("sheet2").Select ActiveWindow.DisplayWorkbookTabs = False Application.ScreenUpdating = True لم اجربه .. اتمنى ان يكون صحيح

يا لطيف 7 شهور .. الحق انك مناضل تفضل : باعتبار اسم الحقل والذي نوعه رقمي في الجدول والذي تبحث عن طريقه اسمه id اعمل مربع نص غير منضم في النموذج واجعل اسمه text1 افتح على التصميم وفي حدث بعد التحديث لمربع النص المذكور الصق هذا الكود Private Sub text1_AfterUpdate() Dim rs As Object Set rs = Me.Recordset.Clone rs.FindFirst "[id] = " & Me![text1] If Not rs.EOF Then Me.Bookmark = rs.Bookmark End Sub ان كان نوع الحقل في الجدول نصيا ستحتاج الى تغيير بسيط في الكود

يمكنك استعمال هذا المعادلة في الخلية D3 و السجب نزولاً =C3/SUM($C$3:$C$13)*$D$1

اقتراح صفير حضرتك طبعا هتوضع الكتب على ارفف ضع كود للارفف بحيث يسهل على حضرتك البحث عن كتاب مثال الرف A والرف B والكتاب رقم 1 ياخذ الرف A والكتاب 1 = A\1 انشى جدول بالمواضيع مثال علمى - تاريخى - ادب - دينى - الخ لانى صممت برنامج لمكتبة قبل ذلك وعلى بركة الله ابدى البرنامج

أخي الكريم محمد في الخلية D4 اكتب المعادلة بهذا الشكل =SUMPRODUCT(($A$4:$A$16=A4)*($C$4:$C$16=C4)) ويمكن عمل التنسيق الشرطي بالاعتماد على النتائج من هذا العمود عن طريق تحديد النطاق A4:C16 ثم اكتب المعادلة التالية في التنسيق الشرطي =D4>1

الأخ العزيز البغدادي بطريقة أخرى - بعد إذن الأساتذة الغوالي يمكنك إضافة خلية لمجموع عمود المتبقي وتضع المعادلة C3/$C$1)*$D$1)= في D3 وتسحب نزولا بحيث إذا تمت إضافة اسماء جديدة ومبالغ جديدة يعاد التوزيع من جديد أرجو الاطلاع على المرفق تحياتي المصنف1.zip

يوضع الكود في حدث المصنف .. افتح محرر الأكواد Alt + F11 ثم دبل كليك في نافذة المشروع على ThisWorkbook ثم الصق الكود .. لتجربة الكود غير التواريخ واحفظ المصنف وأعد فتحه لتتأكد من المطلوب

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

وفقك الله لكل أخي " ياسر " .. واحسنت على الحلول الرائعة .. بارك الله فيك

أخي أبو خليل اشكر اهتمام بس علامة التعجب اللي بعد ال me كل ما احطها تتمسح لوحدها فحذفت المسافة وخليت الالتيك ون على نفس السطر اشتغلت الحمد لله بس للاسف في حالة عدم وجود الرقم بيجيب اول سجل

وجزيت خيراً بمثل ما دعوت لي أخي الكريم الحمد لله الذي بنعمته تتم الصالحات ..

اليك البرنامج يعمل اتوماتيك 1- ادخل بيانات المدرسين 2- ادخل بيانات المدرسة وعدد المراقبين لهذة المدرسة 3 - شاشة توزيع المراقبين فقط اضغط على توزيع ثم تحديث بيانات 4 - تقارير طباعة كل المدارس او بالمدرسة برنامج توزيع المراقبين على لجان المدارس1.rar

ربنا يبارك فيك استاذ عبد السلام وشكرا لمرورك الطيب استاذ ياسر

النسخة الاخيرة من البرنامج شكرا لكل من ساعدنى وشكرا للسادة الافاضل القائمين على هذا الموقع اسم المستخدم : محمود الرقم السرى : 1990 برنامج حساب 1العجز والزيادة.rar

بسم الله الرحمن الرحيم ونكمل مع بعض المشوار فى تعلم vba اكسل الجزء الرابع واليكم فيديو جديد https://youtu.be/SsCRpQ1zkGs

جزاكم الله خيرا جميعا وتشرفت بهذا المنتدي الرائع والاشخاص الرائعه والمميزه كل الشكر لكم ولمنتداكم

كل الاحترام لكم فعلا افدتوني جدا و اقتراحاتكم كانت رائعه يسعد مساكم و بغلبكم دائما انا... بما انني جديد و بتعلم من خبراتكم الواسعه بما انو برنامج لموزع لشركه اتصالات و في مشتركين و بتجدد الاشتراك كل شهر هل في طريقه انو كل شهر تنزل فاتوره تلقائي مع العلم انه المبلغ الي بندفع هو مبلغ محدد .....موعد الدفع كل 20 الشهر لكل المشتركين (المشكله الي واجهتها انو كل شهر بدخل على المشترك و بجددلو اشتراكو بس لو فرضنا انه المشترك غاب عني 3 شهور لازم يكون متراكم عليه 3 فواتير )

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

الأستاذ / عبدالسلام أبو العوافي ،، شكراً جزيلاً لاهتمامك .. ولكن نظراً لأني لست خبيراً بالمعادلات والدالات في الإكسل.. آمل التوضيح أكثر كيفية نسخ عنوان الملف بشكل صحيح وأين أضعه في المعادلة التي ذكرتها .. هل توضع مكان الأصفار فقط؟ =HYPERLINK(RIGHT("0000"&ROW()-1;4)&".pdf") ..آمل التوضيح بمثال لشكل المعادلة بعد إضافة العنوان مع أطيب التمنيات لك بكل خير..

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

استاذ ياسر خليل .....اشكرك جدا جدا جدا جزاك الله خيرا .... اخى العزيز استاذ اسامه .... جزيت عنى خيرا زادك الله من علمه ....ونفعت به الناس معادلات رائعة ومنوعه .... تسلم ايدك

كذا لا بد من حفظ الارقام المستخرجة في حقل في احد الجداول عملت لك جدول وبداخله حقل رقمي وعند اضغط على زر المعاينة يتم تحديث الحقل بزيادة واحد على القيمة وفي التقرير نجلب الرقم الحاصل هذه الفكرة تطبق في دائرة الاحوال الشخصية للدولة بحيث يكون في سجل الشخص حقل خاص يزيد عند كل امر طباعة للهوية الشخصية لذا نلاحظ الرقم الخاص ببدل الفاقد ظاهرا على البطاقة db2.rar

شكراااااااااااااااااااااااااااااااااااااااا على مجهود حضرتك وتعبك أستاذ عبد السلام أبو العوافى

قم بحذف المعادلات في العمود BF وجرب هذا الكود Dim i As Integer For i = 6 To 1000 If Cells(i, "f") > 0 Then Cells(i, "bf") = Cells(i, "f") Else Cells(i, "bf") = 1 End If Next

=HYPERLINK(RIGHT("0000"&ROW()-1;4)&".pdf") تضع المعادلة في الصف الثاني وتقوم بسحبها للاخر

شكرا جزيلا بارك الله فيك

السلام عليكم المرفق يمنع الطباعة الا عن طريق الكود .. اضف كود الطباعة فيه وجرب بالنسبة لاخفاء التبويبات .. يجب اخفاء التبويب والخيارات وشريط المهام السريع QAT لمنع المستخدم من ارجاع التبويب http://www.rondebruin.nl/win/s2/win001.htm هذا الموقع قد يفيدك Prevent Print.rar

أخي وحبيبي عبد السلام وماذا عن روح التحدي ؟! أليست روح جميلة مثلها مثل روح التعاون ..نحن نسعى لنتعلم من بعضنا البعض ، والمستفيد هو الجميع في النهاية وليس صاحب الموضوع فحسب .. أنا على الدوام أسعى للحلول المختلفة .. ولو بحثت بالمنتدى ستجد فكرة للأسف توقفت وهي أن كل أسبوع كان مخصص لبحث موضوع معين ، والكل يشارك فيه .. وبصراحة كان موضوع متميز ، لكن يبدو أن الأعضاء لم يطالبوا به وانشغلت قليلاً فتوقف موضوع البحث .... تقبل تحياتي

السلام عليكم و رحمة الله و بركاته اخي جرب هذا تعديل ب استعلام الاضافي TimeCount attendance.zip

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

وعليكم السلام ورحمة الله وبركاته أخي الكريم عبد الرحمن أهلاً بك في المنتدى ونورت بين إخواني ..بس يا ريت اللي يبارك لك تعدل الصورة عشان دماغي اتلوحت بالنسبة لسؤالك .. قم بتغيير الخاصية TabIndex بحيث تقوم بالترتيب الذي ترغبه حيث أول تكست بوكس سيكون صفر .. وحدد التالي وغير الخاصية إلى 1 ..ثم حدد التالي وغير الخاصية إلى 2 .. وأكمل ولا تكمل إنت تقبل تحياتي

بارك الله فيك أخي العزيز أبو عبد الرحمن البغدادي .. والملف معبر عن المطلوب على ما أعتقد والله أعلم جزاكم الله خيراً

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

=INDIRECT("Sheet1!B7")

حلو ... نستطيع عملها لنموذج الواجهة الرئيسية ... حياك الله ...

تم الحل شكرا لكما

جرب الكود بهذا الشكل Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub On Error Resume Next If Not Intersect(Target, Range("C1:C60000")) Is Nothing Then VBA.Calendar = vbCalGreg If IsEmpty(Target) Then Target.Offset(0, 2).ClearContents Else With Target.Offset(0, 2) .Value = Date .EntireColumn.AutoFit End With End If End If End Sub تقبل تحياتي

السلام عليكم وبعد اذن بحار جزاه الله خيرا تفضل ضع الكود في حدث زر الطباعة Me.Refresh Dim r, i As Integer Dim rs As Recordset Set rs = Me.SExtendedDetails3.Form.RecordsetClone rs.MoveLast r = rs.RecordCount rs.MoveFirst For i = 1 To r rs.Edit rs!Printed = "s" rs.Update rs.MoveNext Next rs.Close Set rs = Nothing سيتم تعبئة الحقول بحرف s ويمكنك تغييره الى الرقم او النص الذي تريد

السلام عليكم أولا اعتذر عن التاخر في الرد وذلك لانني لمم اتصل مند ثلاثة أيام اخي ابو البراء جزاكم الله خيرا على مروركم و كلماتكم الطيبة و إلتفاتتكم الحسنة تشجيعا لكل الاخوة ، أحسن الله إليك و أثابك الجنة أخي مهند لقد تم عمل المطلوب m222.rar

وعليك السلام ورحمة الله وبركاته لقد تم التعديل مثل ما طلبت أخي بالاعتماد على المعادلة التالية: (بالفرنسية) =NB.SI($E$3:$E$22;C3)=1 أما بالانجليزية فتكون بالشكل التالي: =COUNTIF($E$3:$E$22;C3)=1 كذلك أضفت لك عدد المرات المكررة بالاعتماد على المعادلة التالية: (بالفرنسية) =SI(NB.SI($C$3:$C$22;E3)=0;"";NB.SI($C$3:$C$22;E3)) أما بالانجليزية فتكون بالشكل التالي: =IF(COUNTIF($C$3:$C$22;E3)=0;"";COUNTIF($C$3:$C$22;E3)) وأضفت لك كذلك هل الفحص مكرر صح أم خطأ ؟ بالاعتماد على المعادلة التالية: (بالفرنسية) =NB.SI($C$3:$C$22;E3)>1 أما بالانجليزية فتكون بالشكل التالي: =COUNTIF($C$3:$C$22;E3)>1 أرجو أن أكون قد وفقت في مساعدتك في حل إشكالك وان كان هذا هو الحل فلا تنسى وضع اعجاب في انتظار ردك تحميل الملف المرفق: المكرر معدل.rar

السلام عليكم اخي الكريم انا الان لا زلت اعمل على برنامج يكون فيه لغتين العربية والتركية المرحلة التي وصلت لها هي : 1- أنشأت جدول وضعت فيه رسائل التحذير باللغتين حتى استخدمها في msgbox 2 - أنشأت جدول وضعت فيه المسميات للأزرار ومربعات النص 3- طبعا وفي جدول الخيارات يكون فيه خيار تحديد اللغة 4 - أنشأت وحدات نمطية لتسهيل الاتصال بجداول المذكورة سابقا واخيرا ما زال العمل قائم على المشروع والتحدي الأكبر سيكون عندما يعمل البرنامج على كل الاجهزة مع اختلاف الاعداد الاقليمية بين الأجهزة

تفضل اخي الغالي date.rar

الا خت الفاضله بفرض ان الرقم فى الخلية A1 انسخى هذه المعادله فى الخلية B1 =IFERROR(IF(A1<=75000;A1*5%;IF(AND(A1>75000;A1<=150000);(A1-75000)*10%+75000*5%;IF(A1>150000;(75000*5%)+(75000*10%)+(A1-150000)*15%;0)));0) وبالتالى ممكن يكون كل الارقام فى العمود A فقومى بسحب المعادله من B1 الى ما تريد من عدد الصفوف تقبلى تحياتى