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

الأخوة الكرام أعضاء المنتدى فضلاً لا أمراً، يرجى مراعاة تجنب الأسماء أو الكنيات الغريبة فيما يخض إسم الدخول للموقع user name ،و يفضل كون اسم الدخول باللغة العربية و عدم استخدام الأسماء الغريبة او غير المعتادة سواء باللغة العربية أو غيرها. مع مراعاة أن إسم الدخول لا يقبل التكرار بين الأعضاء، و عليه فيمكن إضافةأرقام أو نقطة مثلا بين الاسم واسم العائية (محمد.عرفه) مثلا ليصبح فريدا اذا كان الاسم المطلوب مسجلا من قبل. كما يرجى من الجميع اضافة الاسم الحقيقي باللغة العربية فى الحقل المناظر، والهدف هو تسهيل التواصل الفعال بين الأعضاء ، و ان تعذر فيتم اختيار كنية باللغة العربية فى مكان الاسم الحقيقي ملاحظة : سيتم تعديل أي أسماء دخول أو أسماء حال مخالفتها للذوق العام أو احتوائها على أي إيحاءات غير معتادة. توضح الصور التالية كيفية تغيير اسم الدخول و تسجيل الاسم الحقيقي

هذه طريقة بدون اكواد .... انظر DB1.accdb

السلام عليكم انا واجهت مشكلتك من قبل وللتغلب عليها قمت بالكود التالى وهو عيارة عن تحديد مكان كل خليه تريدها بدلا من الكود الاصلى الذى يقوم على تحديد بداية الصف والعمود فقط قم بتغيير مايلزم وافتح الشيت قدامك وانتا بتغير الارقام Dim iRow As Long Dim ws As Worksheet Set ws = Worksheets("اسم الشيت اللى هترحل منه البيانات") iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(9, 2).Row ws.Cells(iRow, 2).Value = Me.TextBox2.Value iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(10, 2).Row ws.Cells(iRow, 2).Value = Me.TextBox3.Value iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(11, 2).Row ws.Cells(iRow, 2).Value = Me.TextBox4.Value iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(12, 2).Row ws.Cells(iRow, 2).Value = Me.TextBox5.Value iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(13, 2).Row ws.Cells(iRow, 2).Value = Me.TextBox6.Value iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(14, 2).Row ws.Cells(iRow, 2).Value = Me.TextBox7.Value iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(15, 2).Row ws.Cells(iRow, 2).Value = Me.TextBox8.Value iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(16, 2).Row ws.Cells(iRow, 2).Value = Me.TextBox9.Value iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(17, 2).Row Me.TextBox12.Value = ws.Cells(iRow, 2).Value iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(22, 7).Row ws.Cells(iRow, 2).Value = Me.TextBox13.Value iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(23, 1).Row هنا انا كنت بدخل على عمود رقم اتنين بس بغير رقم الصف ولما حبيت اغير المكان قمت بتغيير رقم العمود اتمنى ان يكون الحل مناسب لك

ضع هذا في المديول Function salary1(frm As String) If Forms(frm)!المهنة = "طبيب" Then Forms(frm)!الراتب = 10000 ElseIf Forms(frm)!المهنة = "مهندس" Then Forms(frm)!الراتب = 9000 ElseIf Forms(frm)!المهنة = "صيدلي" Then Forms(frm)!الراتب = 8000 ElseIf Forms(frm)!المهنة = "معاون طبيب" Then Forms(frm)!الراتب = 7000 ElseIf Forms(frm)!المهنة = "معاون مهندي" Then Forms(frm)!الراتب = 6000 ElseIf Forms(frm)!المهنة = "" Then Forms(frm)!الراتب = 0 End If End Function استدعيه من النموذج بهذا الكود Call salary1(Me.Name) DoCmd.RefreshRecord

اعرض الملف حركة الصندوق السلام عليكم ورحمة الله وبركاته أقدم لحضراتكم عملاً متواضعاً عن حركة الصندوق لمتجر صغير يتضمن الوقت والتاريخ تلقائياً أثناء قبض أو صرف مبلغ ما حيث تتم كتابة الاسم والبيان وفي أحد حقلي الصرف أو القبض ليتم حساب حركة الرصيد تلقائياً للمقارنة مع الفئات النقدية وتسجيلها هناك زر تبديل في حالة القبض(وجه سعيد مبتسم) وفي حالة الصرف(وجه حزين) حيث نكتب أرقام كل فئة بجانبها ثم نضغط على زر + في حال الإضافة وعلى إشارة - في حال الصرف .... على أن يراعى سعر الصرف في حال كتابة حركة الصندوق بعملة محددة ودفع أو قبض بعملة ثانية للمقارنة بين رصيدي الفئات والمقبوضات هذا الملف مفتوح المصدر لإجراء أي تغييرات على نوع العملة ... أما حماية الشيت فهي تلقائية يمكنكم إيقافها في حال التعديل سائلاً الله تعالى أن يجعل به الفائدة لمن يرغب بتنزيله ...كما نسألكم الدعاء لي ولوالدي ولولدي الحبيب "علي" الذي وافته المنيّة منذ مدة وجيزة ولجميع موتى المسلمين بالرحمة والمغفرة والفوز بالجنة والنجاة من النار ....آمين والسلام عليكم ورحمة الله وبركاته. صاحب الملف محمد حسن المحمد تمت الاضافه 10 يون, 2020 الاقسام قسم الإكسيل

السلام عليكم هذا موقع أحد الشركات الهولندية و هي تدعم هذه الخاصية https://metamicro.nl/en-gb

مشاركه مع اخوانى واساتذتى جزاهم الله خيرا ع قد حالى اعمل استعلام تحديث واختار حقل الصوره وضع المعيار التالى فى التحديث الى مع تغير كلمه المسار التالى الى المسار الجديد بدون اسم الملف Replace([figura];Left([figura];InStrRev([figura];"\";InStrRev([figura];Right([figura];1))));"D:\photos\") Database2.accdb

نفس المشكلة حدثت معى والله اخى

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

تم معالجة الامر الكود Option Explicit Sub Get_ALL() Dim Arr(), m, I, itm Dim Ro%, Col%, My_sum# Dim k% m = 1 Principal.Range("B7:B13").ClearContents If Application.CountA(Principal.Range("B4:B6")) < 3 Then MsgBox "Incomplete Data" & Chr(10) & _ "Ckeck Up For Empty The Cells,B4,B5,And B6" Exit Sub End If If Principal.Range("B4") > Sheets.Count - 1 Then Principal.Range("B4") = 1 End If If Principal.Range("B5") > Sheets.Count - 1 Then Principal.Range("B5") = Sheets.Count - 1 End If If Principal.Range("B5") < Principal.Range("B4") Then Principal.Range("B5") = Principal.Range("B4") End If m = 1 For I = Principal.Range("B4") To Principal.Range("B5") ReDim Preserve Arr(1 To m) Arr(m) = Sheets(Principal.Range("B4") + m).Name m = m + 1 Next '++++++++++++++++++++++++++++++++++ For k = 7 To 13 For Each itm In Arr Ro = Sheets(itm).Range("B4:B21").Find(Principal.Range("B6"), lookat:=1).Row Col = Sheets(itm).Range("C3:Z3").Find(Principal.Range("A" & k), lookat:=1).Column + 2 My_sum = My_sum + Val(Sheets(itm).Cells(Ro, Col)) Next itm Principal.Range("B" & k).Value = My_sum My_sum = 0 Next k End Sub الملف مرفق MaKhazin.xlsm

جزاك الله خيرا اخى واستاذى محمد @Barna 💐 وفيك بارك الله اخى @عبداللهM مرفق صورتين من ع نفس المرفق للتوضيح

جرب كدا وخبرنا ...... Pro-In-Tmt.accdb

غير خصاىص userform . كما في الصوررة ShowModal من القيمة false الى true لا يمكنك الكتابة . او اتركها false للكتابة على الصفجة و محرر الاكواد شغال.

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

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

انظر المرفق ...... ما هو الداعي لاستخدامها في الاستعلام ( الراتب مسجل في الجدول ) انشئ الاستعلام من الجدول مباشرة أنظر الاستعلام في المرفق .... test (8).accdb

أشكركم على تثبيت الموضوع أساتذتي الكرام مسؤولي منتدى أوفيسنا العريق بارك الله بكم وأحسن إليكم ....آمين

أحسن الله إليك وجزاك بمثل مادعوت لي وزيادة آمين أخي الحبيب @Ali Mohamed Ali أشكر لكم مروركم العطر وكلا مكم الطيب تقبل تحياتي العطرة

أحسنت استاذ محمد عمل ممتاز جعله الله فى ميزان حسناتك ورحم الله والديك ووسع الله فى رزقك وأكرمك الله فى أولادك

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

والله استانا / @أحمد الفلاحجى بتعمل اللى عليك واكثر وتحاول بجميع الطرق تقديم المساعدة ربنا يجزاك خير ويزدك من العلم ويرزقك من غير حساب

جزاك الله خيرا جزاها الله خيرا ام عهود عذرا ده تسجيل الاداه للعمل وليس الترخيص ع ما يبدوا أنني اقد للتركيز بقالي يومين بعتذر مره اخرى التركيز رايح خالص فقد وفرت ام عهود الترخيص وهو كالتالى من نفس الموضوع فالمشاركه التاليه واقرائها جيدا http://arabteam2000-forum.com/index.php?/topic/170595-التقاط-صورة-الموظف-بالكميرا-او-بالماسح-الضوئي-وحفظها-في-مجلد-الصور/&do=findComment&comment=862306 جزاها الله خيرا وتم تجربه الترخيص فى نفس التقرير الذى به المشكله وعمل جيدا الحمدلله رب العالمين إن شاء الله أحد اخواننا واساتذتنا يفيد بما لديه من معرفه حول الاداه بالتوفيق

اخي غير المسار الى: CurrentProject.Path & "\photo\Worker"

هذا هو ربط مثال http://arabteam2000-forum.com/index.php?/topic/170595-التقاط-صورة-الموظف-بالكميرا-او-بالماسح-الضوئي-وحفظها-في-مجلد-الصور/

حسب اسم الموضوع و لأنه لا يوجد مثال مرفق للعمل عليه لتغيير المسار من D:\Photo\Worker الى مسار البرنامج CurrentProject.Path & "\Worker"

السلام عليكم في الغالب جهازك قد اصيب بفيروس الفدية ابحث عن حل له في الانترنت او مع متخصصين في الحماية مثال https://sensorstechforum.com/pezi-virus-file/ هذا مجرد مثال ولا أعرف مصداقية الموقع فلست متخصصا في الحماية ملاحظة : تم حذف الملف المرفق مع الطلب بصورة احترازية، واقترح عدم مشاركة ملفات من جهازك مع احد حاليا

وجدت هذه المعادلة ولكنني هنا ارحل البيانات بشكل افقي Option Explicit Sub TransferUsingArray() Dim Arr With Sheets("1") Arr = Array(.Range("I1"), .Range("I2"), .Range("I3"), .Range("E25"), .Range("E26"), .Range("C9"), .Range("E9"), .Range("G9"), .Range("J9"), .Range("C11"), .Range("E11"), .Range("G11"), .Range("J11"), .Range("C13"), .Range("E13"), .Range("G13"), .Range("J13"), .Range("C15"), .Range("E15"), .Range("G15"), .Range("J15")) End With With Sheets("2") .Range("A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Resize(1, UBound(Arr) + 1).Value = Arr End With MsgBox "Done...", 64 End Sub ولكنني اريد ترحيل الاعمدة التي تحتوي على الطلبات بشكل اعمدة

و عليكم السلام أخي. أانت قلت اذا كان "F3="A يعطي قيمة H3. نلاحظ أن f4=a من أين جاءت 3 و الخلية h4=1 وضح أكثر أخي و ان شاء الله سنجد لك الحل

تفضل Book1.xlsm

وهذا تطبيق كلام الاخ Barna test.accdb

السلام عليكم ورحمة الله وبركاته تم تعديل المثال من البداية وباختصار ايضاً وتم دمج كود تجاهل المسافات تم اضافة Function changesearch(Mytxt) As String Dim tempstr As String tempstr = Nz(Mytxt, "") tempstr = ReplaceChar(tempstr, "أإآاء") tempstr = ReplaceChar(tempstr, "ةته") tempstr = ReplaceChar(tempstr, "ىي") tempstr = ReplaceChar(tempstr, "وؤ") changesearch = tempstr End Function Private Function ReplaceChar(W As String, c As String) As String Dim R As Byte Dim S As String, i As String For R = 1 To Len(W) i = Mid(W, R, 1) If InStr(c, i) > 0 Then S = S & "[" & c & "]" Else S = S + i End If Next R ReplaceChar = S End Function وفي حدث عند الخروج تم اضافة Private Sub Mysearch_Exit(Cancel As Integer) Dim newsearch As String newsearch = changesearch(Me.Mysearch) M = "SELECT * FROM Customer WHERE CusName Like '*" & PartOfName(newsearch, 1) & "*" & PartOfName(newsearch, 2) & "*" & PartOfName(newsearch, 3) & "*" & PartOfName(newsearch, 4) & "*" & PartOfName(newsearch, 5) & "*" & PartOfName(newsearch, 6) & "*';" Me.CustomerFind_subform.Form.RecordSource = M Me.Mysearch.SetFocus End Sub UP-adv find test_2.rar تحياتي

السلام عليكم ورحمه الله وبركاته أ/ ضاحى الغريب الكود اللى حضرتك منزله ممكن توظفه فى شيت اكسل على شان اعرف طريقه إستخدامه بعد إذنك وشكرآ