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

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

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

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-ترحيل-بيانات-من-ورقة-عمل-رئيسي-إلى-مجموعة-أوراق-عمل/

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

السلام عليكم اخي الفاضل كود بدائي ولكنه يقوم بالواجب ان شاء الله. طباعة_الكل.xls

أنا لم أفهمك اخى الكريم لأنى قمت بعمل كل اللى انت طلبته ولم يعجبك فماذا أفعل ؟!!!! كما ترى بالصورة واذا كان التفقيط يظهر لك بلغة غريبة عما هو موجود بالصورة فلابد من ضبط اللغة العربية عندك فبها مشكلة ويتم ضبطها من لوحة التحكم (Control Panel)

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

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

حياك الله

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

لاحظ الاستعلام الموجود ...... مواد (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) مشاركة

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