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

تفضل ..... Sub kan() On Error GoTo w Dim i As Integer Dim sCount As Integer sCount = Me.Recordset.RecordCount DoCmd.GoToRecord , , acFirst For i = 0 To Me.Recordset.RecordCount Me.datem = DateAdd("d", i, Me.kano) DoCmd.GoToRecord , , acNext Next DoCmd.Requery Exit Sub w: MsgBox "تم" End Sub Private Sub تأريخ_تلقائي_Click() Me.kano = Me.datem kan End Sub

تفضل طبعاً بعد اذن استاذنا الكريم lionheart .. فالأمر سهل جداً ولكن لابد من الضغط على الإعجاب 💙 من طرفكم لما قدمه لكم استاذنا الكبير lionheart الاباء1.xlsm

الحمد انك وجدت الحل مع الشكر والتقدير للمهندس الخبير @Eng.Qassim من وصف المشكلة اجد من وجهة نظر مبرمج سابق لزوم مالا يلزم حفل في جدول يعني عن استعلامين وجدول ولكن لكل شيخ طريقته رأي شخصي غير ملزم وليس الهدف الانتقاد فمشاركاتي تهتم فقط بالجانب النظري تحياتي

In standard module, put the following UDF Function VLookUps(myCode As Range, myList As Range, delim As String, Optional Uniq As Boolean = False) As String Dim e VLookUps = Join(Filter(myList.Parent.Evaluate("TRANSPOSE(IF(" & myList.Columns(7).Address & "=" & myCode.Address(, , , True) & ", " & myList.Columns(2).Address & "))"), False, 0), delim) If Uniq Then With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each e In Split(VLookUps, delim) .Item(Trim(Split(e)(1))) = Empty Next e VLookUps = Join(.Keys, delim) End With End If End Function In cell F2, you can use the UDF as following =VLookUps(Tabla2[@[إسم ولي الأمر]],Tabla1[#All]," - ",TRUE)

بعد إذن جميع الأصدقاء المشاركين في هذا الموضوع الرائع هذا جهدي المتواضع لتحميل الملفات من جوجل درايف بنفس الاسم والامتداد فقط تحتاج رابط الملف كاملا وأن يكون الملف عاما (مشاركا مع الجميع) الكود يعالج مشكلة أسماء الملفات العربية صالح للنواتين 32بت وكذلك 64بت يعمل في كل التطبيقات التي تستعمل vba يوضع هذا الكود في موديول جديد Sub DownloadFromGD(GDriveURL As String) Dim myURL As String Dim FileID As String Dim xmlhttp As Object Dim name0 As Variant Dim oStream As Object FileID = Split(Split(GDriveURL, "/d/")(1), "/")(0) myURL = "http://drive.google.com/u/0/uc?id=" & FileID & "&export=download" Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP") xmlhttp.Open "GET", myURL, False xmlhttp.Send name0 = DECODEURL(xmlhttp.getResponseHeader("Content-Disposition")) If name0 = "" Then MsgBox "الملف غير موجود في الموقع" Exit Sub End If name0 = Split(name0, "*=UTF-8''")(1) 'split after *=UTF-8'' to get utf8 names If xmlhttp.Status = 200 Then Set oStream = CreateObject("ADODB.Stream") oStream.Open oStream.Type = 1 oStream.Write xmlhttp.responseBody oStream.SaveToFile CurrentProject.Path & "\" & name0, 2 ' 1 = no overwrite, 2 = overwrite oStream.Close End If Set xmlhttp = Nothing Set Stream = Nothing MsgBox "تم تحميل الملف في نفس مسار البرنامج باسم: " & name0 End Sub Function DECODEURL(varText As Variant) Static objHtmlfile As Object If objHtmlfile Is Nothing Then Set objHtmlfile = CreateObject("htmlfile") objHtmlfile.parentWindow.execScript "function decode(s) {return decodeURIComponent(s)}", "jscript" End If DECODEURL = objHtmlfile.parentWindow.decode(varText) End Function طريقة استخدام الكود مثل السطر المكتوب في الإجراء test أو يمكن وضعه عند الضغط على زر مثلا ويتكون هذا السطر من كتابة اسم الاجراء DpwnloadFromGD ثم رابط الملف المراد تحميله بين علامتي تنصيص ويمكن استخدام قيمة مربع النص بدلا من تثبيت رابط الموقع Sub test() DownloadFromGD "https://drive.google.com/file/d/18jrvTxgR1QTzwm8YaJHIvsdOmqj02L2x/view" End Sub ولا تنسوني من صالح دعائكم بالتوفيق للجميع

انا بالخدمة ..بالتوفيق يارب

كنت اتصور انك تريده هكذا .. على كل حال استبدل سطر الكومبو للشهر بالتالي strNew = Me.Combo130.Column(1)

اذا لم يفتح عندك البرنامج اضف الكود التالي لاضافة الشهر والسنة .. Dim rs As DAO.Recordset Dim db As DAO.Database Dim strNew As String Private Sub Combo130_Click() Set db = CurrentDb Set rs = db.OpenRecordset("جدول المرتبات") If rs.RecordCount <> 0 Then rs.MoveFirst While Not rs.EOF strNew = Me.Combo130.Value Me.Dirty = False rs.Edit rs.Fields("الشهر") = strNew rs.Update rs.MoveNext Wend End If rs.Close Me.Requery End Sub Private Sub السنة_Click() Set db = CurrentDb Set rs = db.OpenRecordset("جدول المرتبات") If rs.RecordCount <> 0 Then rs.MoveFirst While Not rs.EOF strNew = Me.السنة.Value Me.Dirty = False rs.Edit rs.Fields("السنة") = strNew rs.Update rs.MoveNext Wend End If rs.Close Me.Requery End Sub

شكرا استاذي العزيز المهندس قاسم Eng.Qassim تعبتك شكرا استاذي الغالي مبرمج سابق مبرمج سابق

بالمناسب ..هو حتى لو وضعت مفتاح اساسي سوف لن يعطيك خطأ او بالاحرى تحذير ويتم الالحاق بشكل طبيعي لو وضعت DoCmd.SetWarnings False DoCmd.SetWarnings True

اخي الكريم 🙂 فيه مجموعة اسئلة تحوم حول هذا الموضوع: 1. سؤال هذا الموضوع كان حول المرفق Database10.mdb وانه لا يعمل ، وقد اخبرتك انه معطوب ولا يمكن استرداد بياناته ، بينما تتكلم الآن عن مرفق آخر ، وتريد حذف بعض بياناته ، فأي علاقة بين السؤال الاصل وطلبك الاخير ؟ 2. التقرير الذي تتكلم عنه ، عبارة عن 5 صفحات ، وبه 151 سجل ، منهم 146 سجل بدون تاريخ : . وحتى التاريخ المكتوب في الجدول غير تقليدي : . فكيف تريد ان تختار التواريخ !! 3. تعليقك هذا معناه انك لست صاحب البرنامج : . فعليه ، يجب عليك التواصل بالمبرمج الذي عمل البرنامج ، ليعمل لك اللازم 🙂 قوانين المنتدى تراعي "حقوق الملكية الفكرية" للمبرمج ، وخلاف ذلك يعتبر مخالفا لقوانين المنتدى 🙂 جعفر

To implement With your workbook active press Alt+F11 to bring up the vba window In the Visual Basic window use the menu to Insert|Module Copy and Paste the code below into the main right hand pane that opens at step 2 Close the Visual Basic window Press Alt+F8 to bring up the Macro dialog Select the macro & click 'Run' Your workbook will need to be saved as a macro-enabled workbook (*.xlsm)

تم التعديل ..لكن انتبه الان المعادلة في الخلية F1 هي من نوع الصفيف وليست معادلة عادية اي انها تبدا بقوس وتنتهي بقوس att test#4.xlsb

تفضل اخي المثال في المرفق : ProFile1.rar

لم افهم الية العميل ولن جرب المرفق ربما انتهت مشكلتك ........ Company-v02.rar

Have a look. Is that the desired output

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

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

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

عمل رائع جزاك الله خير الثواب استاذ مجدى

احيان يكون مصدر النموذج الجدول وليس استعلام او اننا لاي سبب لا نرغب في استخدام الاستعلام و نرغب في استخدام الكود مباشرة لعمل الفلترة في حدث بعد التحديث للقائمة نضع الامر التالي ⬇️ Me.Filter = "[Employee_Num]=" & Me.k.Column(0) & "" Me.FilterOn = True [Employee_Num هو حقل رقم العميل k مربع القائمة "لا افضل استخدام الاسماء العربية للحقول " مع اعتزازنا وفخرنا بلغتنا column(0) هو الحقل الاول في القائمة الخاص برقم العميل ولا داعي لعمل تحديث للنموذج مداخلتي من باب تعدد الحلول فقط

عن اذن استاذي @kanory مربع النص في النموذج الرئيسي الذي مصدر سجلاته Employee_Num تجعل المعيار لديه انه يشبه مايتم اختياره من مربع القائمة واهم شي تعمل تحديث للنموذج عند الضغط على مربع القائمة Me.Requery

تفضل التعديل فقط قم بإضافة رابط الملف داخل مربع النص مثال.accdb

أحسنت استاذ ماجد بارك الله فيك

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

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

حيالله مهندسنا العزيز 😊 هذا الاختصار يشغل لك أداة اسمها snipping tool وهي من ضمن أدوات ويندوز ، ووضيفتها أخذ لقطة لجزء من الشاشة أو شاشة كاملة أو لنافذة معينة ( بمعنى انها تسهل لك الموضوع ) ، وبعدها ممكن تعمل لصق للصور في أي مكان بشكل عادي أو تفتح محرر للصور خاص بويندوز لتحرير الصورة .. 🙂 ولمعرفة المزيد: https://en.m.wikipedia.org/wiki/Snipping_Tool

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

السلام عليكم اخى @abouelhassan و اخى @Eng.Qassim مشاركه بسيطه معكم بعيد عن الاستثناء وبصراحه لانى مخى كان متوقف اليومين اللى فاتو 😀 فكره بسيطه عند الضغط دبل كليك على الحقل pay سيتم تفعيل الحقل للصف الذى ضغطت فيه ويمكنك الكتابه وعند الخروج سيتم تفعيل الاحداث مره اخرى وسيتم الوقوف على اول سجل وستجد انه ملون اصفر ولا يمكن التعديل عليه لعدم حدوث اخطاء لعلها تروق لك اخى ابو الحسن فالوقت الحالى بالتوفيق TestLOck -1.accdb

قريبا إن شاء الله .. 😊 طريقة إبداعية جديدة وحصرية لتحديث نسخة الواجهات FE لدى المستخدمين بدون برامج أو أدوات خارجية .. أكسس فقط .. 😉👌🏼 :: ترقبوا ::

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم ...... Aziz (1).rar

بارك الله فيكم جميعا ، يامن تساعدونا في هذا المنتدى لوجه الله بدون مقابل ، وتضيعونا اوقاتكم ومجهودكم لوجه الله اسأل الله العظيم ان يجعله في ميزان حسناتكم ويبارك لكم في صحتكم واولادكم وبيتكم ويزيدكم علماً ونفعا للعباد

موضوع قيم بارك الله فيك وزادك الله من فضله

ممتاز استاذ مجدى بارك الله فيك وجزاك الله كل خير

وذلك بسببك لأنك لاغى ذلك بالكود وذلك بالأسطر الموجودة باللون الأخضر فعليك بحذف الفاصلة العليا على يسار كلمة Me من جميع الأسطر ليصبح الكود كالتالى : Me.ListBox1.AddItem Me.TextBox4.Value Me.ListBox1.List(al, 1) = Me.TextBox5.Value Me.ListBox1.List(al, 2) = Me.TextBox6.Value Me.ListBox1.List(al, 3) = Me.TextBox7.Value Me.ListBox1.List(al, 4) = Me.TextBox8.Value Me.ListBox1.List(al, 5) = Me.TextBox9.Value Me.ListBox1.List(al, 6) = Me.TextBox10.Value Me.ListBox1.List(al, 7) = Me.TextBox11.Value Me.ListBox1.List(al, 8) = Me.TextBox12.Value Me.ListBox1.List(al, 9) = Me.TextBox13.Value 1dwork.xlsm

ممتاز استاذ مجدى جزاك الله خير الثواب , اللهم وسع فى رزقك

بارك الله فيك استاذى الكريم

أحسنت أستاذ مجدى , عمل رائع .. اللهم تقبل منكم سائر الأعمال .. وكل عام وانتم بخير

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

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

بارك الله فيك استاذنا الكريم وزادك الله من فضله

من فضلك طريقة الدخول الأن الى المنتدى بإميلك وليس بإسم المستخدم ... فإذا أردت الدخول فيجب عليك كتابة الإميل ... وشكراً

لا يمكن العمل على القاعدة من اى جهاز به انترنت فقط تحميل واعادة رفع مرة اخرى ان اردت لكن يمكن العمل عليها من مجلد المزامنة فى حالة وجود شبكة محلية على نفس الـ NetWork ولكن سوف تكون ابطأ نسبيا بسبب المزامنة التلقائية الا إن قمت بعمل ايقاف للمزامنة وجعلتها تعمل فى اوقات محددة من خلال الـ schedule ولكن هناك مواقع تقوم بتقديم خدمة سحابة الكترونية يمكنك العمل من خلالها على قاعدة البيانات من اى مكان ولكن بمقابل مادى وباهظ التكاليف مثل https://www.accessdatabasecloud.com/pricing اما جوجول ودروب بوكس سحابة الكترونية تخزينية فقط ------- وهاكم نبذة عن خدمة الموقع Use Your Microsoft Access Database on Cloud Desktops! Microsoft Access Databases can now run faster on cloud desktops than they do on office networks and are also much more secure and stable. You and your team can now use your MS Access database on any of your own devices from anywhere in the world that has an internet connection! Recent improvements in cloud computing technology have made cloud desktops so fast that you might forget you are not working on your own computer. Your Access database can be moved "as-is" to cloud desktops, with no changes, and used anywhere, all the time. Request a free 7-day trial of Microsoft Access on cloud desktops to see how it works on your own devices, from anywhere. الترجمـــــــــــــــــــة استخدم قاعدة بيانات Microsoft Access على أجهزة كمبيوتر سطح المكتب السحابية! يمكن الآن تشغيل قواعد بيانات Microsoft Access بشكل أسرع على أجهزة سطح المكتب السحابية مقارنة بشبكات المكاتب ، كما أنها أكثر أمانًا واستقرارًا. يمكنك الآن أنت وفريقك استخدام قاعدة بيانات MS Access الخاصة بك على أي من أجهزتك الخاصة من أي مكان في العالم به اتصال بالإنترنت! جعلت التحسينات الأخيرة في تقنية الحوسبة السحابية أجهزة سطح المكتب السحابية سريعة جدًا لدرجة أنك قد تنسى أنك لا تعمل على جهاز الكمبيوتر الخاص بك. يمكن نقل قاعدة بيانات Access "كما هي" إلى أسطح المكتب السحابية ، دون أي تغييرات ، واستخدامها في أي مكان وطوال الوقت. اطلب نسخة تجريبية مجانية لمدة 7 أيام من Microsoft Access على أجهزة سطح المكتب السحابية لترى كيف يعمل على أجهزتك الخاصة ، من أي مكان.

بسم الله الرحمن الرحيم كل عام أنتم جميعاً بخير ..... يوجد امتداد ملفات اسمه shs وهو خاص بميكروسوفت أوفيس Shell Scrap Object File وينتج هذا الملف عند نسخ نص من ملف وورد مثلا أو أي برنامج ضمن الأوفيس ثم لصق ما تم نسخه في مجلد وليس في ملف من جنسه هذا الامتداد كان يفتح بمجرد الضغط المزدوج بالفارة على الملف في أوفيس 2003 وويندوز إكس بي ولكن اختلف الأمر مع ويندوز 7 فهذا الملف غير مدعوم ولا يفتح مع برامج الأوفيس 2007 أو 2010 ............. ولمن عانى من هذه المشكلة واستكمالاً لسلسلة (ما خف وزنه وغلا ثمنه) أقدم لكم الحل الأكيد فقط اتبع التعليمات في المرفق وستجد كل شيء على ما يرام ..... ولا تنسوني من صالح دعائكم open .shs in win7.rar

وعليكم السلام -يمكنك استخدام هذه المعادلة =SUMIF(الرواتب!$A:$A,$A2,الرواتب!$B:$B)+SUMIF(الرواتب!$A:$A,$A2,الرواتب!$C:$C) جلب مبالغ 1.xlsx

أحسنت استاذ محمد بارك الله فيك وزادك الله من فضله

بارك الله فى جهودكم وادام الله هذا المنتدى صرح ومنارة علم ومعرفة لكل من أراد العلم والتعلم وبالنجاح والتفوق دائما ونتمنى من الله الإستمرار والدوام على التقدم

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

ويمكن اختصار الكود ليصبح Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Then Exit Sub Target.Offset(0, 1).Value = IIf(Target.Value <> "", Format(Now(), "hh:mm:ss"), "") End Sub

بارك الله فيك أخي عبد الله حلك أفضل من حلي لأن عملية الحساب تقوم بتغيير التواريخ السابقة لأحدث تاريخ موجود أما في الكود الذي تفضلت به فيحتفظ الملف بالتاريخ القديم ويغير فقط تاريخ الخلية التي تمت الكتابة فيها وفقك الله لكل ما يحب ويرضى واسمح لي بإضافة بسيطة ربما يحتاجها أخي صاحب الموضوع وهي حذف التاريخ من الخلية إذا حذفت القيم من خلية في العمود الأول ليصبح الكود هكذا Private Sub Worksheet_Change(ByVal Target As Range) LR = Range("A" & Rows.Count).End(xlUp).Row If Target.Column <> 1 Then Exit Sub If Target.Row > LR Then Exit Sub If Cells(Target.Row, 1).Value <> "" Then Cells(Target.Row, 2).Value = Format(Now(), "hh:mm:ss") Else Cells(Target.Row, 2).Value = "" End If End Sub