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

1- قم بتسمية الورقة الرئيسية بغير رقم مثلاً "main_sheet" او اي اسم تختاره 2-قم بتسمية الأوراق التي ترغب بمسح النطاق منها بالارقام مثلاً "1" "2" "15 " الخ.. نفذ هذا الماكرو (ستلاحظ الاوراق التي يحتوي اسمها على كلمات لا يتعاطى معها الماكرو) الماكرو Option Explicit Sub del_Ranges() Dim my_Srting$: my_Srting = "D5:F35" Dim sh As Worksheet For Each sh In Sheets If sh.Name Like "#*" Then sh.Range(my_Srting).ClearContents End If Next End Sub الملف مرفق كنموذج MOURATABAT.xlsm

لكن ما هذا

السلام عليكم هذا الموضوع طورته وهو من أفكار الأخ الغالي @ابوآمنة احيانا تحتاج لتصميم برنامج لمحل خلويات لذلك ستحتاج الى 4 جداول و4 نماذج عميل ومورد وزبون وموظف كل ذلك في نموذج واحد اتفضلوا بصيغتين عميل مع مورد.accdb عميل مع مورد.mdb

ارفق لنا مثالا ليتم التطبيق عليه

وعليكم السلام-تفضل 11.xlsx

وعليكم السلام و رحمة الله و بركاته عدلت لك كل ما تفضلت و اكثر ان شاء الله علما بان زر (اضافة/تغير صورة) تم ايقاف تفعيله لحين تضغط على احد زرين اضافة مستخدم أو تغير بيانات مستخدم الحالي ، حتى لايتم اختيار صورة قبل اختيار مستخدم بعد ضغط على احد زرين اضغط على زر و اختر الصورة من جهاز بعد ضغط على صورة سيعرض الصورة في مكانها ، و مسارها في مربع مسار الصورة BK .accdb

لماذا تصعب على نفسك ؟!!!! ولما لا تضع هاتين الصفحتين فى ملف واحد بدل من ملفين ؟! عموماً تفضل لك ما طلبت Basic.xlsm Next.xlsx

أحسنت أستاذ وجيه معادلة ممتازة-بارك الله فيك

بارك الله فيك وهديه مقبوله . 🥀

ما شاء الله تبارك الله ..... برنامج جميل ..... تشكر عليه

ما شاء الله عليك أخ @صالح حمادي فكرة جديرة بالتجربة .... بارك الله فيك .... دائما تتحفنا بالجميل ...

وعليكم السلام-أهلا بك في منتدانا الكريم ,تفضل لك ما طلبت رسالة تنبيه.xlsx

السلام عليكم فريق العمل لمشروع أوقات الصلاة يهدون : المنتدى .. ورواده .. وكل المهتمين . الإصدار الأول من برنامج أوقات الصلاة مقدمة : الحمد لله الذي وفقنا لهذا العمل ، والصلاة والسلام على أشرف خلق الله سيدنا محمد وعلى آله وصحبه ومن تبعهم إلى يوم الدين . وبعد؛ فأقدم شكري البالغ للأستاذ الفاضل أبو هادي أن قبلني عضوًا في فريق العمل وتحمل تقصيري وكثرة تغييبي وانقطاعي عن العمل ، ومن ثم شرفني بطرح المشروع كعمل نهائي في إصداره الأول ، فجزاه الله عني كل خير ، فهو بحق أستاذي ؛ فقد تعلمت منه الكثير والكثير ، فإدارته للمشروع إدارة مبدعة ؛ فقد لاحظت غير مرة أنه يطرح الفكرة ويترك الفريق ليفكر فيها ويقوم بتنفيذها وهو يراقب الفريق من قرب ويتدخل في الوقت المناسب بالتوجيه والاجابة على استفسارات أعضاء الفريق . وأشكر إدارة المنتدى ممثلة في الأستاذ محمد طاهر على متابعته للمشروع وملاحظة التطورات بين فترة وأخرى . وأشكر كل من شارك برأي أو ملاحظة أو نصيحة ساعد في تطوير وتفادي بعض الملاحظات فجزاهم الله ألف خير . التوقيع : أعضاء الفريق عنهم أبو سليمان . نبذة عن البرنامج : * الفكرة: للأستاذ المبدع أبو هادي . * بداية المشروع في 24/10/1425هـ وحتى تاريخ 11/03/1426هـ القائمين على المشروع : * مدير المشروع : المبدع أبو هادي . مشاركة كل من الأعضاء : * المشرف : الأستاذ رضوان ، وانضم بتاريخ 25/10/1425هـ * كاتب هذه السطور : أبو سليمان ، وانضممت إلى الفريق بتاريخ 13/11/1425هـ * المشرف : خضر الرجبي ، وانضم بتاريخ 12/12/1425هـ مصادر البيانات : * قام بتزويد فريق العمل بمصدر بيانات المدن الأخ Top . مصادر الأفكار البرمجية : استفاد فريق العمل كثيراً من العديد من الأدوات والدوال والأفكار البرمجية الموجودة في أرشيف المنتدى ومنها : * أداة ودوال تقويم أم القرى . * أداة تقويم النتيجة . * أداة تغيير الواجهة اللغوية – وهي من الأداة السابقة - . * أداة الترقيم التلقائي للتعامل مع الشبكة . * أداة إعادة ربط الجداول المرتبطة . * أداة التعرف على تحميل النماذج IsLoaded. * أداة إظهار/إخفاء خلفية الأكسس ShowWindow. * أداة تشغيل الملفات الصوتية وإيقافها . تنويه : جرى تطوير بعض الأدوات والدوال بعد ملاحظة بعض الإخفاقات أثناء العمل ، أو لتحسين الأداء. مواصفات البرنامج : يمتاز البرنامج بالمميزات التالية : * إضافة الأوقات العربية ( التوقيت الغروبي ) . * إضافة أوقات الليل . * إمكانية تغيير التاريخ لمعرفة أوقات الصلاة لأي يوم تختاره – دون تغيير تاريخ النظام - . * سهولة البحث والإضافة والتعديل لكافة الدول والمدن . * إمكانية تغيير واجهة البرنامج بين العربي والإنجليزي . * تقرير بأوقات الصلاة : - لمدة يوم واحد في عشرة مدن حسب اختيارك _ لأي يوم تختاره - . - لمدة أسبوع في مدينتك بتحديديك لأي يوم من الأسبوع ؛ مع إمكانية تحديد بداية الأسبوع . - لمدة شهر في مدينتك مع إمكانية تحديد الشهر والسنة حسب التقويم الافتراضي . - لمدة سنة كاملة في مدينتك مع إمكانية تحديد السنة حسب التقويم الافتراضي . * إمكانية طباعة التقارير باللغة العربية أو الإنجليزية تبعًا للغة واجهة المستخدم . عيوب البرنامج : للبرنامج بعض العيوب نذكر منها : * إخفاق البرنامج في حساب أوقات بعض الصلوات ( الفجر والعصر والعشاء ) لبعض المدن ؛ وعولج هذا الإخفاق بإخفاء الأوقات المذكورة لتلك المدن في النموذج والتقارير . تم حل المشكلة بتاريخ 22/02/2006م والحمد لله ، مع أنه سيلاحظ في بعض الفترات لبعض البلدان عدم وجود للفجر والعشاء وعولجت كذلك بإخفائها . * عدم تسجيل طريقة حساب أوقات الصلاة لأغلب الدول ؛ واستخدم طريقة لجنة الإشراف على تقويم أم القرى كطريقة افتراضية لها ، ويمكن للمستخدم تسجيل طريقة الحساب المتبعة في بلده من خلال نموذج البحث والتعديل والإضافة . * عدم وجود نموذج خاص لإضافة طريقة حساب بمواصفات خاصة بالمستخدم ، ويمكنه التعديل مباشرة في الجدول (tblPrayerCalculationMethods) . * عدم إمكانية تحديد نوع التقويم لطباعة التقارير ، وتعتمد على التقويم الافتراضي للبلد حسب طريقة الحساب المتبعة . * عند تصغير البرنامج لا يمكن تكبيره يدويًا ، في حين أنه يكبر آليًا عند دخول وقت الصلاة. * عدم وجود نظام تحديث ، سوى مراجعة المنتدى . * عدم عمل ملف تهيئة ( Setup/Install ) . * عدم تعريب أسماء الدول والولايات والمدن . * الاقتصار على ملف صوتي واحد للأذان – بصوت من الحرم المكي - . * عدم وجود لوحة تحكم بافتراضات البرنامج . * عدم وجود ملف تعليمات لتوضيح طريقة الاستفادة من البرنامج وكيفية التعامل معه . طريقة تنصيب البرنامج : قم بتنزيل الملفات المرفقة ثم فك الضغط عنها في مجلد واحد ثم قم بتشغيل الملف المسمى بـ Prayer وفي الختام أسأل الله العلي القدير أن ينفع به عموم المسلمين . والسلام عليكم . تحيات فريق العمل أبو هادي – رضوان – أبو سليمان – خضر الرجبي تفضلوا الجزء الأول الملفات المرفقة Prayer.rar ( 264.46ك ) عدد مرات التنزيل: 610 تم تبديل هذا المرفق بمرفق جديد بواسطة أبو هادي بعد أن تم تصحيح العيب الأول والأكبر في البرنامج كما تمت بعض التنقيحات البسيطة . Prayer_20060222.rar

بيانات الموظف ومرفقات منوعة للموظف الفيديو الصور

Database1.accdbعندي مشكلة في تكرار البيانات في تقارير واستعلامات اكسس من جدولين شاكرا تعاونكم

الرجل المعروف بسخائه ... هدية مقبولة .... جاري التجربة ... بارك الله فيك وفي عملك

اذا كان هناك شيتين منفصلين فلابد ومن الأفضل عمل المعادلات بهذا الكود ويتم وضع هذا الكود فى الملف المراد وضع المعادلة به ,بعد الضغط على Alt F11 ثم فتح مديول جديد ولصق هذا الكود به وربطه بزر كما فى الملف المرسل لك Sub ToList() Dim finalrow As Long Dim wsd As Workbook Dim wsl As Workbook Dim wsdd As Worksheet Dim wsll As Worksheet 'Open Book with database Set wsd = Workbooks.Open("C:\Users\Ali Mohamed\Desktop\Next.xlsx")'لابد من تغيير عنوان الملف هذا لما هو فى كمبيوترك 'Copy using Index and match to worksheet Set wsll = ThisWorkbook.Worksheets("Sheet1") With wsll.Range("g2") < 0 wsll.Range("g2").Formula = "=INDEX([Next.xlsx]Sheet1!$B$2:$B$5000,MATCH(A2,[Next.xlsx]Sheet1!$A$2:$A$5000,0))" 'Copy row down based on first cell where formula is place finalrow = wsll.Cells(Rows.Count, 1).End(xlUp).Row wsll.Range("g2").AutoFill Destination:=wsll.Range("g2:g" & finalrow) End With 'Activate sheet where formula is placed wsll.Activate wsll.Cells(1, 1).Activate End Sub أما فى حالة نفس الملف بصفحتين مختلفين فالأمر لا يحتاج سوى معادلة Index & Match عادية ولا يحتاج الأمر الى كود =IFERROR(INDEX(Sheet1!$B:$B,MATCH(A2,Sheet1!$A:$A,0)),"")

افتح موضوع جديد لسؤالك هذا و ضع مثال لتطبيق عليه و إن شاء الله نجد لك حلا.

بالخدمه أخي الكريم

استاذنا الاستاذ سليم حاصبيا حياك الله وبارك الله لك وجزاك الله خيراً استاذنا هذا هو المطلوب بالضبط شكراً لك استاذنا

أنا ولم أقرأ السؤال جيدا الخطأ مني

و هذا احد حلول New Microsoft Access قاعدة بيانات.accdb

New Microsoft Access قاعدة 906بيانات.accdb

ويمكن الاستفاده من ذلك فى ضبط عملية التكرار أى انه اذا تم ادخال سند رقم رقم مثلا = 11500 = واسم = محمد احمد = وتاريخ = 1-7-2019 = وتريد عدم تكرار ذلك بنفس هذه البيانات يمكن الاستفاده بضبط خاصية = عند الخطأ = بوضع كود برمجى Private Sub Form_Error(DataErr As Integer, Response As Integer) Const conErrRequiredData = 3022 If DataErr = conErrRequiredData Then MsgBox ("هذا السند تم إدخاله من قبل") Response = acDataErrContinue Me.Undo Else Response = acdatadisplay End If End Sub

تفضل https://www.officena.net/ib/topic/45082-تحويل-المعادلات-إلى-أكواد-vba/?tab=comments#comment-264202

جزاك الله خير استاذنا الغالي وجيه هذا ماكنت اريده زادك الله علما

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

ههههههههه من قال الله أعلم علمه الله ما لا يعلم تذكر ذكر اسم الله أخي ابوآمنة و إن شاء الله سوف أشرح الطريقة أولا لإرسال أي بيانات لمكان معين في صفحة الوورد يجب إضافة إشارة مرجعية لهذا المكان لنستطيع التعامل معها. و هذه صورة إنشاء إشارة مرجعية في الوورد: و هذا كود إرسال البيانات إلى مكان الإشارة المرجعية في ملف الوورد الموجود بجانب البرنامج: Dim wApp As Word.Application 'Object Dim wDoc As Word.Document 'Object Set wApp = CreateObject("Word.Application") Set wDoc = wApp.Documents.Open(CurrentProject.Path & "\recap1.dot") wApp.Visible = True 'False wDoc.Bookmarks("fname5").Range.Text = "Officna" wApp.ActiveDocument.SaveAs (CurrentProject.Path & "\1988_Doc.Docx") wApp.Quit Set wDoc = Nothing Set wApp = Nothing

وعليكم السلام -طالما انك لم تقم برفع ملف وشرح المطلوب بكل دقة وتجنبا لعدم اهدار الوقت -يمكنك الإطلاع على هذه الروابط فبها ما تطلب https://www.officena.net/ib/topic/93250-كود-واحد-يرحل-جميع-البيانات-الى-جميع-الادارات-وفق-اسم-الادارة-ونوع-المدرسة/ https://www.officena.net/ib/topic/93145-ترحيل-بيانات-من-ورقة-عمل-رئيسي-إلى-مجموعة-أوراق-عمل/

وعليكم السلام-طالما انك لم تقم برفع ملف , فيمكنك الإستعانة بالملف الموجود على هذا الرابط وكان عليك من البداية استخدام خاصية البحث فى المنتدى قبل رفع مشاركتك ,فهناك العديد من الموضوعات التى تخص طلبك https://www.officena.net/ib/topic/92655-مشروع-صغير/?tab=comments#comment-579758

نطاق الفاتر مؤلف من 10 اعمدة من A الى J لذلك لا يوجد عامود رقم 22

جرب الملف الأن تم التعديل ولا تظهر هذه الرسالة

ليس هناك مشكلة في هذا -أهم حاجة ان الملف يعمل بكل كفاءة

حياك الله

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

لاحظ الاستعلام الموجود ...... مواد (1).accdb

وعليكم السلام-لابد ان يحدث معك هذا الخطأ لأنك تقوم بكتابة المعادلة بطريقة غير صحيحة فلابد ان تكون المعادلة هكذا في كل الصفحات فمثلا اذا كان المبلغ المكتوب بالأرقام الذى تريد تفقيطه في الخلية R2 =kh_TextNum($R2,ورقة1!$E$3,ورقة1!$E$4,ورقة1!$E$5,ورقة1!$E$6,$E$7,$E$8,$E$9) صندوق.xlsm

تفضل يمكنك تفهم هذا من هذه الصورة , ثم بعد خطوات الصورة يمكنك عمل Cut للكود ثم التعديل عليه كما تريد وهذا هو الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Range("A1:h1,H3:H4,E2:G1004,C1000:C1004"), Target) Is Nothing Then Target.Offset(0, 1).Select End If End Sub

هذا ثوبي نسيته في المطعم

فضلا منك أدخل بيانات في الجدولين حتى نعرف كيف يتم عمل البرنامج ..... لأنك انت الوحيد الذي تعرف عمل البرنامج .....

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

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

لا حاجة لعدد من الزرار يساوي عدد الشيتات الكود Option Explicit Sub get_Eleves_Names(ByVal my_SHEET As String) Rem ====>>>> Created By Salim Hasbaya On 27/6/2019 '================================ Dim y%, SH As Worksheet Dim ss%: ss = 0 For y = 1 To Sheets.Count If Sheets(y).Name Like "*#*" Then ss = ss + 1 End If Next '============================ Dim m As Worksheet: Set m = Sheets("Main") Dim Fst As Worksheet: Set Fst = Sheets(my_SHEET) Dim Ar(4), Ar_Fasl(1 To 9) Dim t: t = Sheets(my_SHEET).Index Dim lrA%: lrA = m.Cells(Rows.Count, "A").End(3).Row Dim lrF%: lrF = m.Cells(Rows.Count, "F").End(3).Row Dim mal$: mal = "ذكر" Dim fem$: fem = "انثى" Dim i% Dim Start_row_B%: Start_row_B = 10 Dim Start_row_H%: Start_row_H = 10 Fst.Range("b10").Resize(500, 11).ClearContents With m For i = 2 To lrA Ar(0) = .Cells(i, "H"): Ar(1) = "" Ar(2) = .Cells(i, "G"): Ar(3) = .Cells(i, "A") Ar(4) = .Cells(i, "C") If .Range("B" & i) = mal Then Fst.Cells(Start_row_B, "B").Resize(, UBound(Ar) + 1) = Ar Start_row_B = Start_row_B + 1 ElseIf .Range("B" & i) = fem Then Fst.Cells(Start_row_H, "H").Resize(, UBound(Ar) + 1) = Ar Start_row_H = Start_row_H + 1 End If Next For i = 4 To 12 Ar_Fasl(i - 3) = CStr(Fst.Cells(5, i)) Next Fst.Range("c10").Resize(Start_row_B - 10) = _ Application.Transpose(Ar_Fasl(t - 1)) Fst.Range("I10").Resize(Start_row_H - 10) = _ Application.Transpose(Ar_Fasl(t - 1)) Fst.Range("K1") = ss End With Set m = Nothing: Set Fst = Nothing Erase Ar: Erase Ar_Fasl End Sub '================================================== Sub EXTACCT_NAME() Dim Impt Dim x% Impt = InputBox("Please Give_me the sheet's name to transfer data" & _ Chr(10) & "Write the sheet's name Without Cotes") If Impt = "Main" Then MsgBox "I can't Change the values of Principal Sheet" Exit Sub End If On Error Resume Next x = Len(Sheets(Impt).Name) If x = 0 Then On Error GoTo 0 MsgBox "The Sheet: " & Impt & " Not Existes" Exit Sub End If Call get_Eleves_Names(Impt) End Sub يكفي زر واحد و الماكرو يطلب منك اسم الشيت التي تريد الترحيل اليها مثل هذه الصورة(كتابة اسم الشيت بدون الأقواس) الملف مرفق للمعاينة وابداء الرأي Mes_Eleves_new.xlsm

يمكنك متابعة هذه الصور لمعرفة كيف يتم ذلك (بدون اي كود) اذا اردتها بالماكرو الكود Sub hide_tabs() ActiveWindow.DisplayWorkbookTabs = False End Sub لاعادة اظهارها استبدل False بـــ True

Private Sub CommandButton7_Click() Application.Visible = True Sheet1.Activate Sheet1.Visible = True 'الشيت المراد اظهاره Sheet2.Visible = False Sheet3.Visible = False Unload Me End Sub تفضل الكود

بارك الله فيك أستاذ وجيه معادلة ممتازة ولإثراء الموضوع بعد اذنك هذه معادلة اخرى =OFFSET(Sheet1!$B$3:$B$33,COLUMN()-COLUMN($C$2)+((ROW()-ROW($C$2))*(ROWS(Sheet1!$B$3:$B$33)/$B2)),0,1,1) نقل بيانات من عمود الي صف بكود.xlsm

اتفضل اخى الحبيب الملف لعله يفى بالغرض ولكن بمعادلات ضع رقم الحالة بناء عليه يتم جلب البيانات ويقوم بجمع قطع الغيار نسخة من نقل بيانات من عمود الي صف بكود.xlsm

=ROUND(MAX(MIN(7%*I5;135);65);2) مشاركة

أخي الفاضل مصطفى سيد جاد إليك الكود التالي عله يكون المطلوب Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) Dim strSheet As String If InStr(Target.Parent, "!") > 0 Then strSheet = Left(Target.Parent, InStr(1, Target.Parent, "!") - 1) Else strSheet = Target.Parent End If Sheets(strSheet).Visible = True Sheets(strSheet).Select End Sub Private Sub Worksheet_Activate() Dim WS As Excel.Worksheet For Each WS In ThisWorkbook.Worksheets WS.Visible = (WS.Name = Me.Name) Next End Sub يوضع الكود في حدث ورقة العمل الرئيسية وإليك الملف المرفق لتوضيح الأمر لا تنسى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي لا تنسى أن تنقر كلمة "أعجبني هذا" في المشاركة التي أعجبتك تقبل تحياتي Hide All Sheets & Unhide When Click On Hyperlink.rar

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