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

نظرا لأن برنامج اكسل لا يقدم خيار المعاينة على اليوزرفورم أردت أن أقدم فكرة للزملاء الكرام و أعضاء المنتدى الاعزاء الفكرة تعتمد على أخذ صورة للنطاق المراد طباعته على القرص و اعادة تحميلها على مربع الصورة مهم جدا : انشاء مجلد لحفظ الصورة على c باسم raed ثم شغل الملف المرفق C:\raed يمكنك تغيير القرص و اسم المجلد في الكود كما تشاء ثم غير اسم المحلد حسب الكود Private Sub CommandButton1_Click() Const RaedN As String = "C:\raed\officena.jpg" Dim rng As Range Dim shtTemp As Worksheet Dim chtTemp As Chart Application.ScreenUpdating = False Set rng = Worksheets("Sheet1").Range("b2:h11") Set shtTemp = Worksheets.Add Charts.Add ActiveChart.Location Where:=xlLocationAsObject, Name:=shtTemp.Name Set chtTemp = ActiveChart rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture chtTemp.Paste chtTemp.Export Filename:=RaedN Me.Image1.Picture = LoadPicture(RaedN) Application.DisplayAlerts = False shtTemp.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub preview on userform.xlsm

جرب ووافيني بالنتيجة ..... BA.mdb

جرب هذا الكود ملاحظة مهمة جدا ً المطلوب ابقاء العامود B (فارغاً ) و الا يتم مسح كامل البيانات Option Explicit Sub Salim_Regex() If ActiveSheet.Name <> "ورقة1" Then Exit Sub Dim Mot As String Dim My_Regex As Object Dim arrWords As Variant Dim RA As Long, x As Long Dim m As Long, Ro As Long Range("C2").CurrentRegion.ClearContents RA = Cells(Rows.Count, 1).End(3).Row Set My_Regex = CreateObject("VBScript.RegExp") My_Regex.Global = True My_Regex.Pattern = "([\+]?\(?\d+\)?\W\d+\W\d+)+" m = 3 For Ro = 2 To RA Mot = Cells(Ro, 1) If My_Regex.test(Mot) Then Set arrWords = My_Regex.Execute(Mot) For x = 0 To arrWords.Count - 1 Cells(Ro, m) = arrWords(x) m = m + 1 Next x End If m = 3 Next Ro End Sub الملف مرفق Use_Regex.xlsm

تفضل تم عمل المطلوب الدليل بالصورة الطلبة.xlsm

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

File Dialog يحتاج لاضافة Reference : MicroSoft Office 14 Object Library ورقم 14 هو اصدار الأوفيس ويتغير حسب ما لديك بنظام التشغيل

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا 💐 والشكر موصول للاستاذ جمال @Gamal.Saad و محمد @Barna 💐 واذا سمح اخوانى واساتذتى بالاستفسار بالنسبه لاستعمال الاوبجيكت كما اشرت سابقا لتذكرى مره قد قال اخى ومعلمنا العزيز جعفر استعمال الاوبجيكت يغنينا عن استعمال المكتبات ولكن عند تجربتها لم تعمل وعند استعمال المكتبات تعمل وبالبحث وجدت ان الاشاره للاوبجيكت لوحده ليس كافى بل يستخدم بعض المتغيرات ايضا ولعل اخواننا واساتذتنا يوضوحون

عليكم السلام ورحمة الله وبركاته خلية اسم الشهر في ورقة العمل J1 وفي الكود كانت I1 وتم تعديلها جرب هذا لعله يفي الغرض Payroll123-3-2020 - Copy.xlsm

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

جدول Temp جدول مؤقت لاستيراد البيانات له من الاكسس قبل الحاقه للجدول الاساسي ...

بالتوفيق اخي الكريم تحياتي

تضمين الخطوط في Word أو PowerPoint انقر فوق علامة التبويب ملف ، ثم فوق خيارات (الموجودة بالقرب من الزاوية السفلية اليمني من النافذة). في العمود الأيمن ، حدد علامة التبويب حفظ . في الأسفل ، ضمن الاحتفاظ بالدقة عند مشاركه هذا العرض التقديمي، حدد خانه الاختيار تضمين الخطوط في الملف . يؤدي تحديد تضمين الأحرف المستخدمة في العرض التقديمي إلى تقليل حجم الملف ولكنه يحد من تحرير الملف باستخدام الخط نفسه. يؤدي ترك خانه الاختيار هذه إلى زيادة حجم الملف ، ولكن من الأفضل السماح للآخرين بتحرير المستند والاحتفاظ بالخط نفسه. من المستحسن ترك خانه الاختيار فارغه إذا كان الشخص الآخر يستطيع تحرير الملف. انقر فوق موافق.

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

تفضل تم الحل بطريقتين بمعادلات المصفوفة (Ctrl+Shift+Enter) =IF(ROWS($L$3:L3)>COUNTA($B$3:$B$500),"",INDEX($B$3:$B$500,SMALL(IF($B$3:$B$500<>"",ROW($B$3:$B$500)-ROW($B$3)+1),ROWS($L$3:L3)))) وايضا بالكود .. حتى تختار المناسب لك من بين الحلين Sub Rectangle1_Click() On Error Resume Next Worksheets("Sheet1").Range("b3:c100").SpecialCells(xlCellTypeConstants).Copy Worksheets("Sheet1").Range("I3:I100") Application.CutCopyMode = False End Sub جلب بيانات عمود بدون فراغات.xlsm

السلام عليكم ورحمة الله تم عمل المطلوب في الملف مثل ما ذكرت بالأعلى وأرجو أنه يفي الغرض... بن علية حاجي الكنترول_اليمني.xlsm الكنترول اليمني.rar

وعليكم السلام هل هناك علاقة بين هذه الجداول ... اقصد علاقة ربط ...

اريد من الزملاء الاعزاء المساعدة فى عمل كود طباعة لجميع الشهادات مرة واحدة من فضلك طالما حجم الملف صغير , فلابد من رفعه بدون ضغط .وذلك تجنباً لعدم اهدار وقت الأساتذة , وبما انك تريد الحل والإجابة بالأكواد فكان عليك لزاما رفع الملف بإمتداد XLSM بيان ناجح 6.xlsm

هده محاولة تفضل فكرة تسجيل القيم في عمود آخر ثم عند اختيار الخلية a1 و عند اعادة الاختيار يظهر مجموع القيم في الخلية a1 يمكنك التطوير كيفما شئت الجمع.xlsm

هذه الكلمة تظهر فقط على الشاشة ولا تظهر في الطباعة

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

تسلم الأنامل بارك الله فيك

واياك أخي قاسم .... بالتوفيق

تفضل اخي الكريم byanat.rar تحياتي

السلام عليكم يمكن جعل خاضية حقل combobox = allow multiple values = Yes انظر الجدول Table2 Db1.rar تحياتي

الكود يعمل معي في الملف المرسل لك .... هل جربت الملف ولم يعمل معك ؟؟

انا لم اتدخل في الكود وانما تعديلي للمشكلة الموجودة في بداية موضوعك أخي الكريم .... هذا هو كودك وفعله .....

وعليكم السلام ورحمة الله وبركاته يمكن وضع مصدر البيانات للحقل الموجود بالتقرير هكذا =[Forms]![Form1]![Text1] بشرط ان يكون النموذج مفتوح تحياتي

جرب الملف .... BA.mdb

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

مشاركه مع اخى واستاذى @Gamal.Saad جزاه الله كل خير 💐 اخى الفاضل @khasem ما هو اصدار الاوفيس الذى لديك ؟ سيتم استدعاء المكتبه الذى اشار الاستاذ جمال اليك عليها كالتالى وتختلف من اصدار لاصدار يعنى فوق 14 ولدى 16 لان الاوفيس لدى 2016 ويمكن بدل استدعاء المكتبه Dim objFilePicker As FileDialog Dim objFilePicker As object بالتوفيق اخى

عند انشاء العلاقات طبق كما في الصورة ....... واجعل التعديل لـ ID من خلال النموذج للجدول الاساسي فيتم تعديل الـ ID في كل الجداول المرتبطة به دون الحاجة لتعديلها في كل جدول على حدا ,,,,,,

بارك الله فيك

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

مشاركة مع اخي اشرف بدون الحاجة الى تغيير وضع حجم الرسم عن طريق الكود في حدث عند الفتح ضع التالي Me.InsideHeight = 9200 ضع الرقم المناسب حسب رغبتك وانا افضل هذه الطريق حيث لا يمكن للمستخدم تغيير حدود النموذج عن طريق السحب Database701.accdb

شغل النموذج وتعالي علي حرفه من تحت وشد للطول اللي انت عايزه

السلام عليكم ورحمة الله أعتقد أن هذا ممكن جدا ويجب الاستغناء عن معظم المعادلات الموجودة في الصفحة وتغيير البعض منها مع استعمال النطاقات الديناميكية وتعديل كود الطباعة الموجود حاليا... أطلب منك القليل من الصبر وسأحاول، بإذن الله، تبسيط عمل الملف بما يفي المطلوب... بن علية حاجي

نفس ملفك المررفق. ضع الكود في موديل جديد.

Sub Printg() Application.Calculation = xlAutomatic For J = [Y2] To [Y1] If J <= [Y1] Then ActiveSheet.PrintOut Copies:=1, Collate:=True End If Next End Sub بيان ناجح 6.xls

السلام عليكم اخى @ازهر عبد العزيز مشاركه مع اخوانى واساتذتى @ابو تراب و @ابو ياسين المشولي جزاهم الله خيرا 💐 بالنسبه لهذا الاجراء فالماكرو كما تحب سيتم استخدام الخاصيه setproperty ولعدم التمكين نكتب اسم العنصر اى الحقل او الزر ثم نختار نوع الخاصيه وهنا ممكن والقيمه false وللتمكين مره اخرى تكون القيمه true تقبلوا تحياتى ومرورى اخوانى واساتذتى وفقكم الله azhr.accdb

وعليكم السلام 🙂 اهلا وسهلا بك في المنتدى 🙂 رجاء مراجعة قوانين المنتدى ، حتى لا تتعرض مشاركتك للحذف : قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف هذا السؤال تكرر اكثر من مرة ، ومع انه نستخدم هذا الكود عادة في برامجنا ، إلا انه قليلا جدا !! فهل هذا واجب منزلي او مساق في الكلية/الجامعة ؟ ابحث في المنتدى وستجد المواضيع ان شاء الله 🙂 جعفر

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

جرب هذا الملف Special_sum.xlsx

أخي عبد الله السعيد . يمكن أنك تستعمل ملفات أخرى غير المرسلة من طرفك 1- يجب أن تكون الملفات هنا : C:\MyFolder و اذا كانت ملفاتك في مجلد آخر غيره في الكود : في هذا السطر fPath = "C:\MyFolder\" 2- تأكد من امتداد الملفات 3-اسم الورقة التي تجلب منها البيانات في الملفات المتعددة ربما ليست SHEET1 غيرها في الكود اذا كنت تستخدم اسم آخر في هذا السطر LR = Worksheets("SHEET1").Range("XEY" & Rows.Count).End(xlUp).Row Worksheets("SHEET1").Range("XEY2:XFD" & LR).Copy 4- ربما ورقة العمل في الملف الرئيسي ليست "MASTER"في ملفك الرئيسي . غيرها في هذا السطر Set wsMaster = ThisWorkbook.Sheets("Master") بالتوفيق

لقيت هذا الكود لا نشاء مجلد Sub MakeMyFolder() انشاء المجلد ' Dim fdObj As Object Application.ScreenUpdating = False Set fdObj = CreateObject("Scripting.FileSystemObject") If fdObj.FolderExists("C:\Users\ALHDRAMI\Desktop\as") Then MsgBox "Found it.", vbInformation, "Kutools for Excel" Else fdObj.CreateFolder ("C:\Users\ALHDRAMI\Desktop\as") MsgBox "It has been created.", vbInformation, "Kutools for Excel" End If Application.ScreenUpdating = True End Sub وهذا كود ثاني لانشاء مجلد وحفظ شيت معين بداخله Sub Mfolder_Export_SheetPDF() 'انشاء ملف Dim Name As String, Path As String Path = "c:\Snow Eagle" & Format(Now, "dd-mm-yyyy hh.mm.ss") MkDir Path Name = Sheets("Sheet3").Name Sheets("Sheet3").ExportAsFixedFormat xlTypePDF, Path & "\" & Name End Sub مشكلة أني لم استطع توظيف اي منهن في الفكرة التي في ذهني فهل احد يتفضل بالمساعدة وجزاكم الله خير الجزاء

الاخ وليد ابو عمر Run.Cmd وجدن لك من النت ملف باتش ( سكريبت ) يقوم بمهمة الدمج في ملف جديد يسمي combined.csv يوصع في فلدر ملفات csv نفذ الملف وانتظر قليلا ستجد ملف بأسم combined.csv في نفس الفلدر Report.rar

تحية لكل زملائى وأساتذتى وأخوتى فى هذه الجامعة وبعد حل أستاذى ( بن علية ) حل أخر لإثراء الموضوع اقسام.rar

السلام عليكم الكود منقول وهو للاخ (amroomo) مع إضافة بضع التناتيش عليه ليتناسب وطلبك الكود سيقوم بحفظ نسخة من الفاتورة في ملف باسم العيادة في الدرايفر D فاذا كان اسم العيادة موجود مسبقاً يتم اضافة العمل الى هذه العيادة والا يقوم بانشاء فولدر جديد جرب واعلمني بالنتيجة BSI2.zip

7. اختصار التغييرات الغير ضرورية التي تم تسجيلها : رأينا في المشاركة الأولى أن مسجل المايكرو ينتج أكواداً لا تتميز بالكفاءة بسبب قيامه بتسجيل جميع الحركات التي يقوم بها المستخدم حتى و لو كانت غير ذات أهمية (كتنشيط الأهداف) ، و اليوم سنتحدث عن مشاكل أخرى يعاني منها مسجل المايكرو تدفعنا إلى عدم الاعتماد عليه بصورة نهائية في إنتاج الأكواد و ذلك عن طريق تنقيح الأكواد بعد توليدها : أولاً : عدم قدرة مسجل المايكرو على تمييز الخيارات التي تم تعديلها من داخل صناديق الحوار : لنقم بتسجيل المايكرو التالي ، وذلك حتى نستطيع معاينة المشكلة بصورة واضحة : اضغط على الخيار Record New Macro الموجود في القائمة Tools (القائمة الفرعية Macro) لتبدأ عملية تسجيل المايكرو. حدد المجال B9:G17 . الآن انقر على الخيار Cells الموجود في القائمة Format لتظهر لك نافذة : ضمن التبويب Font و تحت Font style اختر نوع الخط مثقل (Bold) و اضغط OK . أوقف تسجيل الماكرو من نفس الخيار السابق (لاحظ تغير اسمه إلى Stop Recording). الآن اضغط على Alt+Enter لتفتح لك نافذة محرر الفيجوال ، افتح الموديل المنشأ لترى فيه الكود الذي تم تسجيله مؤخراً: Sub Macro1() Range("B9:G17").Select With Selection.Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With End Sub الآن أعد شكل الخط الموجود في خلايا المجال B9:G17 إلى Regular أو Italic و شغل الكود السابق ... بالتأكد ستشعر بالنشوة و ذلك لأن كودك المسجل قد أدى المهمة التي حددتها له سابقاً و قام بتغير شكل الخط إلى Bold :( و لكن مهلاً يا أخي ... لا تتسرع بالحكم و ذلك خوفاً من أن تصيبك صدمة إذا ما قمت بتجريب الكود السابق عدد من المرات الإضافية. :p الآن قم بتغيير نوع الخط الموجود في المجال السابق B9:G17 إلى Andalus و شكله إلى Italic و قم بعدها بتجريب الكود الذي قمت بتسجيله سابقاً : سوف تصرخ قائلاً بأنك لم تحدد للمسجل (عند تسجيل الكود السابق) أن يغير نوع الخط إلى Arial :@ لكي تحدد ماهية المشكلة السابقة يجب أولاً التعرف على الأسلوب الذي يستخدمه مسجل المايكرو في توليد أكواده . كما قلنا سابقاً ، فإن مسجل المايكرو لا يقدر على تمييز الخيارات التي تم تعديلها من داخل صناديق الحوار ، كيف ؟ عندما قمت (في المثال السابق) بتغيير شكل الخط إلى Bold فإن مسجل المايكرو لم يستطيع و للأسف معرفة الخيار الذي قمت بتعديله ، ولتعويض عن هذا النقص قام المسجل (عندما قمت بالضغط على الزر OK) بإدراج قيم جميع الخيارات الموجودة في التبويب Font. مما لا شك فيه أن المشكلة السابقة تسبب قصورين خطيرين في الكود المنشأ : زيادة حجم الكود ، و عدم القدرة على تنفيذ مهام محددة و مفصلة . حل هذه المشكلة بسيط جداً ، و يتلخص في حذف جميع التغييرات الغير ضرورية من الكود و الإبقاء على الأسلوب المطلوب فقط ، لاحظ التعديل التالي للكود السابق : Sub Macro1() Range("B9:G17").Font.FontStyle = "Bold" End Sub ثانياً : عدم قدرة مسجل المايكرو في كثير من الأحيان على توليد أكواد مختصرة : كما تعودنا ، لنقم بتسجيل مايكرو يتضمن المشكلة موضوع البحث : اضغط على الخيار Record New Macro الموجود في القائمة Tools (القائمة الفرعية Macro) لتبدأ عملية تسجيل المايكرو. حدد المجال B9:G17 . الآن انقر على الخيار Cells الموجود في القائمة Format لتظهر لك نافذة : ضمن التبويب Border قم بإحاطة جميع خلايا المجال بخط ذو سماكة و لون قياسيين ، و من ثم اضغط OK . أوقف تسجيل الماكرو من نفس الخيار السابق (لاحظ تغير اسمه إلى Stop Recording). الآن اضغط على Alt+Enter لتفتح لك نافذة محرر الفيجوال ، افتح الموديل المنشأ لترى فيه الكود الذي تم تسجيله مؤخراً: Sub Macro2() Range("B9:G17").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Sub لاحظ أخي أن الكود السابق يقوم بإدراج الخطوط في كل موضع بصورة مستقلة عن الموضع الآخر. يمكننا اختصار الكود السابق إلى ما يلي : Sub Macro2() With Range("B9:G17").Borders() .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Sub و لكن هل يمكننا اختصار الكود السابق بصورة أكثر ؟ يمكننا عمل ذلك فقط عندما تكون الخيارات المحدد ة من نوع Default ، كيف ؟ عندما تبحث داخل التعليمات البرمجية تجد أن الثوابت xlContinuous ، xlThin ، xlAutomatic الخاصة بالمعاملات السابقة LineStyle ، Weight ، ColorIndex هي من النوع Default ، أي أن الخط المستمر و العرض الرفيع و اللون التلقائي تعتبر من الخصائص الافتراضية في الأسلوب Borders ، و بما أن جميع الخصائص المستخدمة في الكود السابق تعتبر من و جهة النظر البرمجة خصائص افتراضية ، فيمكننا بذلك حذف هذه الخصائص و الإبقاء على خاصية واحدة منها فقط ، وذلك لأن الاكسل سيدرجها بصورة افتراضية ، لاحظ التعديل التالي على الكود السابق : Sub Macro2() Range("B9:G17").Borders().LineStyle = xlContinuous End Sub بالتوفيق

السلام عليكم الاخ الاستاذ محمد تعودنا منك سرعة الرد و الاجابة اشكرك و جزاك الله خير .. بخصوص الدالة بالفعل تعطي النتيجة في حال معرفة رقم العامود و رقم الصف ... و تعطي القيمة التي تقاطع العمود مع الصف ... اشكرك و لقد توصلت دالة تعطي نفس النتيجة بدون معرفة رقم العامود و الصف ... طبعا مقتبسة من نفس الدالة التي اوردتها انت و هي : =INDIRECT(ADDRESS(ROW(5:5);COLUMN(E;E))) اشكرك اخ محمد مرة اخرى و نفعنا الله بعلمك ... اخوك ...

السلام عليكم ... جرب التعليمة ADDRESS مع التعليمة INDIRECT : =INDIRECT(ADDRESS(A1;B1)) الصيغة السابقة تقوم بإرجاع قيمة الخلية المحدد برقم السطر الموجود في الخلية A1 ورقم العامود الموجود في الخلية B1 . بالتوفيق