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

تفضل ..... 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

لم ارى خانة فاضية .... انظر

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

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خير والشكر موصل لاخى ومهندسنا العزيز @Eng.Qassim 🌹 تقبلوا تحياتى وبالتوفيق

جميعا بإذن الله

جزاكم الله خيرا استاذنا الفاضل lionheart فكلمة الشكر لا تكفي فلكم مني دعوة في ضهر الغيب وكذلك الشكر لكم اخي الفاضل هاني على المساعدة فبارك الله فيكم اجمعين

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

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

اخي الفاضل الشكر لله ثم للمهندس قاسم فانا فقط وضعت مداخلة بسيطة وبما انك وجدت الحل المطلوب والحمد لله فسوف اتحدث قليلا عن فائدة حقل في الجدول الذي اشرت اليه في ردي السابق وكيف يؤثر على عمل قاعدة بيانات ويمنعنا من الخطا ويغنى عن وجود جداول متعددة تحتوي على نفس النوع من البيانات ومثالنا برنامج للموارد البشرية في جدول الموظفين وضعنا حقل رقمي واسميناه الحالة اذا كانت القيمة 1 يكون الموظف على راس ويدرج اسمة في بيان الرواتب و كشوف العمل الاضافي و الاجازات وووووو الخ القيمة 2 يكون الموظف تم تعيينة ولكن لم يباشر الوظيفة وبالتالي غير مستحق للراتب وووو الخ القيمة 3 الموظف مكفوف اليد يدرج اسمة ضمن كشف الرواتب ولا يستحق سوى 50% من الراتب ولا يستحق اي من مميزات الموظف القيمة 4 استقالة لا يستحق اي من المميزات ماعدا شاشة التعويضات القيمة 6 متقاعد مبكر فقط يدرج اسمة في شاشة مكافاة نهاية الخدمة بحد اقصى 4 اشهر وشاشة التعويض عن الاجازات الخ وهذه الحالات كثيرة ولكن هذا مجرد مثال مع ملاحظة ان هذة القيمة للحقل لايتم ادخالها بشكل يدوي وانما من شاشة القرارات والرقم يسجل اليا بناء على نوع القرار الان يتبين ان جدول واحد للموظفين يكفي ولا داعي لجداول للمتقاعدين وللمنقطعين والمتوفيين ....... الخ وايضا لا داعي لاستعلام الالحاق الخلاصة تكرار نفس البيانات في اكثر من جدول يعني ان هناك قصور في فهم عمل قاعدة البيانات كما تعودت ان اشير دائما مداخلاتي ليس لانتقاد اي عمل وانما تعبر عن وجهة نظر لمبرمج سابق تحياتي

كلام حضرتك مظبوط هو انا خفت لمعرفش اعملها

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

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

اعتقد ان السبب في وجود مفتاح اساسي في tblBounceEndService

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

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

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

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

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

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

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

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

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

وعليكم السلام-من فضلك عليك بمعرفة ودراسة المعادلة بتفسك وان لا تغير المدى بها وعليك ان تتأكد انها تبدأ من الصف الرابع وليس العاشر كما قمت انت بتغييرها.وشكراً =SUMIF(مشتريات!$C$4:$C$585,مخزن!A3,مشتريات!$D$4:$D$585)-SUMIF(مبيعات!$C$4:$C$582,مخزن!A3,مبيعات!$D$4:$D$582) اسعار المنتجات فاتورة2.xls

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

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

وعليكم السلام-لك ما طلبت wor2.xlsm

بسيطة وذلك من خلال هذا الكود .. سيتم تفعيله من أيقونة تصفير ,,, الموجودة بالصفحة الرئيسية Sub ResetForm_Click() Dim ws As Worksheet With Worksheets("الصندوق") .Range("C3:J40").ClearContents End With Worksheets("كشف عميل").Range("b4:c4").ClearContents With Worksheets("المبيعات") .Range("a3:g40").ClearContents End With Worksheets("كشف مورد").Range("b4:c4").ClearContents With Worksheets("المشتريات") .Range("a3:g40").ClearContents End With With Worksheets("العملاء الموردين") .Range("C2:C40").ClearContents .Range("E2:I40").ClearContents End With With Worksheets("أصناف المبيعات") .Range("a3:E200").ClearContents End With With Worksheets("اصناف المشتريات") .Range("a3:E200").ClearContents End With With Worksheets("الأصناف") .Range("B3:B40").ClearContents .Range("D3:I40").ClearContents End With With Worksheets("الموردين") .Range("A4:B200").ClearContents End With With Worksheets("شيكات") .Range("B4:B200").ClearContents End With End Sub Data_All1.xlsm

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

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

وعليكم السلام-تفضل تم تنظيم الملف ... كل ما عليك اختيار كود الموظف من القائمة الموجودة بالخلية I1 وسيب الباقى على الإكسيل أما ملف Horizontal لجلب كل الموظفين بأسماء أصنافهم وأعدادها أفقياً بدون تكرار ex1.xlsx Horizontal.xlsm

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

بارك الله فيك أخي الكريم أبو خليل وزادك الله علما ونفع بك

أخي شاعر لوقف هذه الرسائل استعمل الأمر التالي DoCmd.SetWarnings False قبل كود الاستعلام ولا تنس أن تعيد قيمتها إلى true بعد تنفيذ الاستعلام DoCmd.SetWarnings True ..... وبالنسبة لموضوع تسجيل وقت الخروج ضع كود استعلام التحديث لوقت الخروج في حدث عدم التحميل للنموذج Private Sub Form_Unload(Cancel As Integer) Your code here End Sub ولا تنس تعطيل التحذيرات قبل تنفيذ الاستعلام وتمكينها بعده

أخي الكريم عماد دائما سباق إلى الخير كنت أفكر في استعمال الأمر crop ولكنك سبقتني جزاك الله كل خير وكل عام وجميع الأحباب في منتدانا بكل خير

ويمكن اختصار الكود ليصبح 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

دالتك صحيحة أخي الكريم ولكن يلزمها تحديث البيانات استعمل هذا الكود بعد الضغط دبل كلك على this work book Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Application.Calculate End Sub ولا تنس أن تجعل تنسيق الخلية التي بها المعادلة تاريخ

عذرا أخي العزيز عبد الله لم أر مشاركتك وقت إرسالي مشاركتي وفقك الله لكل خير دائما سبّاق إلى الخير

جرب هذه المعادلة =DATE(YEAR(A1),12,31)