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

الرابط الذي اشار الية الاستاذ @اشرف فيه افكار مفيدة وخصوصا تفصيل استاذنا الفاضل @ابوخليل ولكن لم يكتمل الموضوع لعدم رد استاذنا الحلواني لانشغاله بالعشرة الاواخر الله يتقبل منا ومنكم صالح الاعمال على كل حال الفكرة تتركز على جدول الاصناف وكما اشرت سابقا ان الباركود سهل العمل بشكل كبير لكون رمز باركود الكرتون يساوي رمز باركود العلبة والاختلاف في اخر رقمين فقط في الصورة المرفقة عند توريد اي كميات يتم استخدام العنصر الاصغر للصنف في حساب الكميات لو اشترينا 10 كرتون ماء كل كرتون يحتوي على 40 علبة تكون الكمية في المخزن 400 علبة عند البيع لو بعنا علبة واحدة باستخدام باركود العلبة يكون المتبقي 399 علبة والسعر هنا يكون بسعر العلبة ولو بعنا كرتون واحد يكون المتبقي 360 علبة والبيع يتم بسعر الكارتون طبعا توجد حلول وافكار اخرى ابحث في الموقع وستجد الكثير من الحلول الافضل تحياتي

الباركود رمز مميز للسلع يسهل عملية ادخال الاصناف وبيعها كما يمكن معرفة البلد المنتج للسلعة بكل سهول ويمكن وضع حقل في تفاصيل الاصناف لبلد الانتاج مثلا 10045886217 علبة 10045886248 كرتون 100 يدل على ان هذا المنتج من الولايات المتحدة الارقام في المنتصف تدل على الشركة المنتجة للسلعة الارقام الاخيرة تدل على المنتج رمز العلبة داخل الكرتون 17 رقم الكارتون 48 واحيان يكون الكرتون يحتوي على مغلفات واظرف 6294003571405 ظرف 6294003571419 مغلف 6294003571218 كرتون والرمز الثلاثي 629 يدل على ان المنتج الإمارات العربية المتحدة الفكرة في ملف الفيديو ان نستخدم عند ترصيد الاصناف وعند البيع رمز الوحدة الاصغر سواء استخدمنا الباركود لقراءة رمز كرتون او مغلف او ظرف ويتم ذلك من الربط بين الكرتون وما يحتوية والرابط يكون الرمز المتشابه والرمز المختلف ورمز مخفي من رقم واحد يختلف في الحالة كرتون عن مغلف او ظرف والعملية تتم بشكل الى بمجرد تمرير السلعة على قارئ الباركود وكل عام وانت بخير تقبل منا ومنك صالح الاعمال اخي واستاذي الفاضل د. محمد حلبي

البرنامج كجداول واستعلامات ونماذج وتقارير وماكرو وكود ، يعمل على النواتين ، وعلى جميع نسخ الاكسس ، ولكن عندما تستخدم: - مكتبات النواة 32 بت (وجميعها نواة 32 بت (كانت 16 بت وتم تحديثها الى 32 بت)) ، فهذا الشيء الوحيد الذي يجب تغييره بإستخدام PtrSafe وتوابعه من التغييرات (او كما في رابط هذه المشاركة ، او كما في مرفق هذه المشاركة) ، - إلا اذا فيه كائنات OCX خاصة لا تعمل على نواة 64 بت ، وهذا نادر 🙂 اما اذا عملت برنامجك على اكسس نواة 64 بت ، فمن المفترض ان يعمل على الاكسس نواة 32 بت بدون مشاكل وبدون تعديل 🙂 جعفر

وعليكم السلام ورحمة الله وبركاته وأنت بكامل الصحة جرب هذا بعد اضافة كود فاصل الصفحات ...المرتبات قانون81 شهر يوليو2020لعدد220موظف.xlsb

عمل ومجهود رائع من الاستاذ ابو تراب وبالمرور على الكود تجد أن عدد المواد تم الاعلان عنه كمصفوفة باسم ٍSubjects كما يلي : Private subjects(12) As TextBox وهذا النوع يسمى Fixed أو ثابت ومحدد بعدد عناصر للمصفوفة ، ولتحويله لديناميك dynamic يكون الاعلان : Private subjects() As TextBox وذلك حتى تتمكن من تغيير حجم المصفوفة في أي وقت وفي أي مكان بالكود باستخدام الأمر ReDim كالتالي : ReDim subjects(12) ويتم استبدال الرقم الممثل لحجم المصفوفة بقيمة مربع نص به الرقم بالنموذج ، ولأنه يتم استدعاء المصفوفة في أكثر من مكان فيجب أن تستخدم أمر اضافي يحافظ على القيم داخل المصفوفة والتي تمثل درجات المواد الدراسية ، كما يلي : ReDim Preserve subjects(Me.Text1) وعلاوة على ما سبق يجب تغيير مسميات مربعات النص بالنموذج وتكون مسلسلة حتى :1/ يسهل الاشارة إليها 2/توفر عدد أسطر الكود. 3/تمكن من اضافة الكثير من المواد بعد ذلك طبعا أنا أحببت أن تعلم فكرتي في الحل لربما هناك حلول وأفكار أخرى أسرع وأفضل وسأجرب لك ذلك بأقرب وقت ممكن

تم ادراج ماكرو جديد يقوم بما تريد Option Explicit Sub Trasfer_data_Special() Dim R As Worksheet, Act_sh As Worksheet Dim k%, col%, Ro%, Max_ro%, x%, y% Dim Bol As Boolean Dim ST_Dat As Date Dim End_Dat As Date Dim My_sum# Dim Mot$ Mot = "الاجمالى" Set R = Sheets("Report_Youmi") Ro = R.Cells(Rows.Count, 1).End(3).Row R.Range("C3").CurrentRegion.ClearContents ST_Dat = Application.Min(R.Range("I2:J2")) End_Dat = Application.Max(R.Range("I2:J2")) For k = 3 To Ro Bol = Application.Evaluate _ ("ISREF('" & R.Range("A" & k) & "'!A1)") If Bol Then Set Act_sh = Sheets(R.Range("A" & k) & "") Max_ro = Act_sh.Cells(Rows.Count, 1).End(3).Row For y = 3 To 7 For x = 5 To Max_ro If CDate(Act_sh.Cells(x, 1)) >= ST_Dat And _ CDate(Act_sh.Cells(x, 1)) <= End_Dat And _ Act_sh.Cells(x, 2) <> Mot Then My_sum = My_sum + IIf(IsNumeric(Act_sh.Cells(x, y + 2)), _ Act_sh.Cells(x, y + 2), 0) End If Next x R.Cells(k, y).Value = My_sum: My_sum = 0 Next y End If Next k End Sub الملف مرفق My_Repport_Final.xlsm

هذه مشكلة تقريب ، وبالمناسبة فهي مشكلة غريبة جدا للدالة Round المفترض أن : Round(82.5, 0) تساوي 83 لكن الدالة تعطي 82 في مشكلة غير مفهومة للأرقام الزوجية التي يصاحبها رقم خمسة بعد العلامة العشرية على العموم تم الحل باضافة 0.1+ Dynamic Array and form controls up 2.accdb

=DCount("empol";"zahrah";" [startdate] Between [forms]![copy_ff]![startdate] AND [forms]![copy_ff]![enddate] And [zy] = true") وهذا نفس كود الفترة لكن بزيادة شرط جديد : And [zy] = true

هلا اخي جرب المرفق New Microsoft Access Database.zip

يحتاج الحل للمراجعة و التحسين و أهم شيئ في فكرة الحل هو أن تضع أسماء المواد الدراسية في جدول ثم تقوم دالة باستيراد المسميات إلى أماكنها بالنموذج بدلالة رقم المادة Private Sub set_subject_interf() Dim rs As DAO.Recordset Dim F, s, ss As Integer Dim ctl As Control Set rs = CurrentDb.OpenRecordset("Subject") rs.MoveLast: rs.MoveFirst For F = 0 To rs.RecordCount - 1 '''''''' المرور على السجلات للحصول على مسميات المقررات For Each ctl In Me.Controls ''''''''' المرور على كائنات النموذج If ctl.ControlType = acLabel Then ''''''''' المرور على مربعات العنوان فقط ''''''''' تحديد رقم مربع العنوان ومطابقته مع كود المادة s = InStr(5, ctl.Name, "_") If Len(ctl.Name) > 8 Then ss = Mid(ctl.Name, 5, s - 5) If Mid(ctl.Name, Len(ctl.Name) - 3) = "_Lbl" Then If rs!subject_id = ss Then ctl.Caption = Nz(rs!subject_name, "") ' نسخ اسم المادة من الجدول لمربع العنوان End If End If End If Next ctl rs.MoveNext Next End Sub Dynamic Array and form controls 1.accdb

amine14 أين الضغط على الإعجاب لهذه الإجابة الممتازة ؟!!💙

العفو اخى @ازهر عبد العزيز هذه محاوله على قدر فهمى تقبل تحياتى وبالتوفيق New Microsoft Access Database (3).accdb

استاذنا الفاضل / @kha9009lid هذا الفيديو المعروض شغل على مستوى عالى جدا بسم الله ما شاء الله لا يتم عمله الا من خبير الله يوفقك ولكن طبعا لا اسمح لنفسى انا اسأل كيف تم عمل ذلك لانه ثمرة مجهودك وتعبك مع انى فهمت الفكرة الا انى لا اعرف التطبيق عندى خصوصا حكاية الباركورد سوف احاول مرة اخرى فى ترتيب الجداول ـ ـ غير مطلوب اى شئ من حضرتك كل عام وانتم بخير

بعد اذن الاستاد الرائد قد يساعدك هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, dic As Object, rng As Range, chn As Range Dim sNms As Variant, a_b As String, i As Long Set chn = Intersect(Target, Range("C:C")) If Not Intersect(Target, Range("C:C")) Is Nothing Then Set rng = Range("C1", Range("C" & Rows.Count).End(3)) Set dic = CreateObject("Scripting.Dictionary") dic.comparemode = vbTextCompare rng.Font.Bold = True rng.Font.ColorIndex = xlAutomatic For Each c In rng sNms = Split(c, " ") a_b = "" If UBound(sNms) = 2 Or UBound(sNms) = 3 Then a_b = Trim(sNms(0) & " " & sNms(1) & " " & sNms(2)) If Not dic.exists(a_b) Then If UBound(sNms) = 3 Then dic(a_b) = c.Row End If Else c.Characters(1, Len(a_b)).Font.Color = vbRed Range("C" & dic(a_b)).Characters(1, Len(a_b)).Font.Color = vbRed End If End If Next c End If End Sub 11.xlsm

اجعل الأرقام فى المعادلة داخل علامة التنصيص "" =IF(I1="1","القاهرة",IF(I1="2","الإسكندرية",IF(I1="3","بورسعيد",IF(I1="4","السويس",IF(I1="11","دمياط",IF(I1="12","الدقهلية",IF(I1="13","الشرقية",IF(I1="14","القليوبية",IF(I1="15","كفر الشيخ",IF(I1="16","الغربية",IF(I1="17","المنوفية",IF(I1="18","البحيرة",IF(I1="19","الاسماعيلية",IF(I1="21","الجيزة",IF(I1="22","بنى سويف",IF(I1="23","الفيوم",IF(I1="24","المنيا",IF(I1="25","اسيوط",IF(I1="26","سوهاج",IF(I1="27","قنا",IF(I1="28","أسوان",IF(I1="29","الأقصر",IF(I1="31","البحر الاحمر",IF(I1="32","الوادى الجديد",IF(I1="33","مطروح",IF(I1="34","شمال سيناء",IF(I1="35","جنوب سيناء",IF(I1="88","خارج الجمهورية","0")))))))))))))))))))))))))))) الرقم القومى.xlsx

لقد فهمت عليك ماذا تريد انظر الى هذا الملف (الصفحة Target_Sh) Indx_match_Code.xlsm

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

انتبه ولا تورط نفسك 🙂 اذا قصدك ان تنصب الاكسس نواة 64 بت على كمبيوتر آخر ، بحيث ان كمبيوترك الاصل عليه الاكسس نواة 32 بت ، فنعم الرأي 🙂 اما انك تلغي نواة 32 بت ، فقد لا تستطيع تشغيل برامجك اصلا وتتورط بنواة 64 بت !! وانا اقترح ان تبدأ بعمل برنامج فيه جميع المكتبات التي تحتاج لها ، والتي تعمل على النواتين 32/64 بت ، بحيث تصل للمكتبة بسرعة وتعرف طريقة عملها 🙂 جعفر

نعم استاذي الفاضل استاذنا الفاضل ابو تراب متفضل وجزاه الله خير الجزاء

تسلم يا غالي والشكر موصول للأستاذ/ ابو تراب صاحب فكرة الحل منذ البداية وتكفينا دعواتك و سعادتك ما تم حله بالبرنامج من مشكلات

جزاك الله خيراً استاذ خالد 🌹😍 @kha9009lid كل عام وانت بخير

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

الله يفتح عليك ياشيخ الف شكر لك وتقبل تحياتي

جميل جدا بارك الله فيك

اذا كان الاجمالي موجود For x = 2 To Max_ro - 1 و (في حال عدم وجود الاجمالي) For x = 2 To Max_ro بالنسبة للخطأ جرب استبدال هذا السطر ("ISREF('" & R.Range("A" & k) & "'!A1)") بهذا ("ISREF('" & R.Range("A" & k )&"" & "'!A1)") ملاحظة اخرى انت تدرج ارقاماً لاسماء الصفحات جرب ان تدرج نصوصاً مثل Amin ,Kamel ,Mouhammed الخ....

نعم نعم أعتذر خطأ غير مقصود لأن القسمة كانت تتم على العدد المفترض للمقررات + 1 وهذا غير صحيح وتم التعديل بإزالة +1 Dynamic Array and form controls update.accdb

الدوسري 5022 السلام عليكم ورحمة الله حل مؤقت وفي انتظار حلول السادة الاعضاء بداية يلزم تنسيق خلايا التاريخ الهجري بطريقة صحيحية كما بالفيديو ( رابط الفيديو بلالورقة الثانية بالملف المرفق ) بعد تنسيق الخلايا بتنسيق التاريخ الهجري يتم عمل تنسيق شرطي لخلايا انتهاء الصلاحية NOW()-F4>0 حيث تشير =NOW() الي تاريخ اليوم وتشير الخلية F4 الي اول خلية من خلايا انتهاء الصلاحية Copy of warrenty.xlsx

تفضل اخي اسم الورقة غير صحيح لذلك يظهر الخطا تم معالجة الامر Nouveau Feuille de calcul Microsoft Excel - Copie.xlsm

الاستاذ Gamal.Saad

اعتقد ان هذا ها تريده ترحيل.xlsm

تحديث بتاريخ: 20-5-20 في الصفحة الرسمية لمايكروسوفت بتاريخ 8/3/2019 ، فإن مايكروسوفت الآن توصي بتنصيب الاوفيس نواة 64 بت ، وهي النواة التي يتم تنصيبها تلقائيا في الاوفيس 2019 والاوفيس 365. طبعا لا يمكن تنصيب الاوفيس نواة 64 بت ، إلا على الوندوز نواة 64 بت. شو فائدة هذه الرسالة لنا؟ اعتقد من الافضل ان نبدأ بتحويل برامجنا الى النواة 64 بت ، فقد يأتي اليوم الذي تُلغى في نواة 32 بت جعفر

شكراً استاذ عبدالفتاح

تم معالجة الأمر My_Repport.xlsm

اخي الخطا الذي ظهرلي ليس كخطاك لقد قمت بمعالجته ويتم الترحيل عادي Nouveau Feuille de calcul Microsoft Excel - Copie.xlsm

ارفع الملف للمعاينة

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

عليكم السلام ورحمة الله وبركاته جرب هذا ترحيل.xlsm

وفيك بارك الله اخى وضاح @النجاشي بالنسبه لطريقه عرض ورقه البيانات هذه فلا ينفع معها الا التنسيق الشرطى والله اعلى واعلم فقد جربت معها الكود من قبل فلم يعمل معى لعل احد الاخوه واساتذتنا قد يساعد بمعلومه اخرى فان غيرت طريقه العرض لنموذج مفرد او مستمر فاستعمل الكود التالى If Price_Sales <> "" Then Me.Price_Sales.ForeColor = vbRed End If بالتوفيق اخى وضاح

وعليكم السلام اخى وضاح @النجاشي هل هذا ما تريد؟ لون الخط.rar

طبعا تضيف criteria معايير وشروط التنفيذ : =DCount("num_m7_tsd";"cargoo";" [startdate] = forms!copy_ff!startdate AND [time] > [Forms]![copy_ff]![time1] AND [time] < [Forms]![copy_ff]![time2]") dcount_where_date_time.accdb

جزاك الله خير الجزاء استاذ وجعلها الله في ميزان حسناتك

وعليكم السلام ورحمة الله وبركاته سنفرض ان جدول المبيعات به حقل الكمية = ItmQty وبه ايضاً حقل الوحدة = CountInPacket لو ان الكمية مثلاً = 125 اذن الكمية بالكرتون = 10 الكمية بالقطعة = 5 ويتم ذلك في الاستعلام كالتالي اسم الصنف ItmName عدد الوحدات بالكرتونة X1: CountInPacket كرتونة X2: [ItmQty]\[X1] دستة X3: IIf([ItmQty]-([X2]*[X1])>11;1;0) قطعة X4: [ItmQty]-(([X2]*[X1])+([X3]*12)) انظر الاستعلام = ItmQry Db1.rar تحياتي

السلام عليكم اخي الفاضل zyad zyad انظر في هذا الرابط لعلك تجد ما تريد والله الموفق الرابط

السلام عليكم اخى @f16 مشاركه مع اخى واستاذى محمد @أبو عبدالله الحلوانى جزاه الله خيرا ارفق حل بدون اللجوء الى استعلام التحديد والتجميع وهو بداله Dsum فى استعلام التحديث DSum("num";"request";"item_id=" & [item_id]) اضف سجل جديد بالجدول request لاى رقم من الموجودين بالجدول مثال 101 او 102 ثم استخدم استعلام التحديث يمكن عمل استعلام الحاقى بعد ذلك لاضافه السجلات الجديده بالجدول request للجدول story مع عدم تكرار السجلات المدخله من قبل تقبلوا تحياتى وارجو لكم وللجميع التوفيق والنجاح مثال_اوفيسنا_استعلام_تحديث_من_استعلام_تجميع(1).accdb

ربما ينال الاعجاب هذا الملف 1-لا يتم تكرار الأسماء 2-تحديد المجموع لكل اسم الكود Sub transfer_data_with_sum() Dim S1 As Worksheet, S2 As Worksheet Dim Rg1 As Range, x As Range Dim Dic As Object Set S1 = Sheets("ورقة1"): Set S2 = Sheets("ورقة2") If S2.Range("A1").CurrentRegion.Rows.Count > 1 Then _ S2.Range("A1").CurrentRegion.Offset(1) _ .Resize(S2.Range("A1").CurrentRegion.Rows.Count - 1) _ .Clear Set Dic = CreateObject("Scripting.Dictionary") Set Rg1 = S1.Range("A1").CurrentRegion If Rg1.Rows.Count = 1 Then Exit Sub Set Rg1 = Rg1.Offset(1).Resize(Rg1.Rows.Count - 1) For Each x In Rg1.Columns(2).Cells Dic(x.Value) = Val(Dic(x.Value)) + Val(x.Offset(, 1)) Next x If Dic.Count = 0 Then Exit Sub With S2.Range("B2").Resize(, Dic.Count) .Value = Dic.keys .Offset(1) = Dic.Items End With S2.Range("A2") = "الإسم": S2.Range("A3") = "المجموع" With S2.Range("a2").Resize(2, S2.Range("A1").CurrentRegion.Columns.Count) .InsertIndent 1: .Borders.LineStyle = 1 .Font.Size = 14: .Font.Bold = True .Rows(1).Interior.ColorIndex = 19 .Rows(2).Interior.ColorIndex = 28 End With End Sub الملف مرفق Mashri3 _with_Sum.xlsm

بعد اذن استاذنا سليم ولإثراء الموضوع ,,فهذا حل ايضا بمعادلة المصفوفة =IFERROR(INDEX(ورقة1!$C:$C,SMALL(IF(ورقة1!$B:$B=A$2,ROW(A$2:A$5000)-ROW(A$2)+1),ROWS($A$5:A5))),"") المشاريع1.xlsx

جرب هذا الملف الكود Option Explicit Sub transfer_data() Dim S1 As Worksheet, S2 As Worksheet Dim Rg1 As Range Set S1 = Sheets("ورقة1"): Set S2 = Sheets("ورقة2") If S2.Range("A1").CurrentRegion.Rows.Count > 1 Then _ S2.Range("A1").CurrentRegion.Offset(1) _ .Resize(S2.Range("A1").CurrentRegion.Rows.Count - 1).Clear Set Rg1 = S1.Range("A1").CurrentRegion If Rg1.Rows.Count = 1 Then Exit Sub Set Rg1 = Rg1.Offset(1).Resize(Rg1.Rows.Count - 1) Rg1.Columns(2).Copy S2.Range("A2").PasteSpecial Paste:=xlPasteValues, Transpose:=True Application.CutCopyMode = False With S2.Range("A1").CurrentRegion.Rows(2) .InsertIndent 1: .Borders.LineStyle = 1 .Font.Size = 14: .Font.Bold = True .Interior.ColorIndex = 19: .Cells(1, 1).Select End With End Sub الملف مرفق Mashri3.xlsm

وعليكم السلام 🙂 انا من مؤيدي استخدام اعدادات الاسكانر في عمله ، وهذه الاعدادات تقوم بالعمل بشكل رائع ، بدون تدخّل اي من برمجتنا 🙂 لهذا السبب ، لا تعليق عندي على كود الماسح الضوئي واليك ملاحظاتي على الكود : 1. الكود يأخذ الصور بدقة: DPI = 200 ، والمفروض للأرشفة ان تكون DPI = 300 ، 2. الكود يأخذ صورة للشاشة بحجم A4 ، فيكون هناك مكان فارغ في الكثير من الصور الصغيرة ، وفيه هدر للمساحة التخزينية : Scanner.Items(1).Properties("6151").Value = 8.3 * DPI 'Horizontal extent Scanner.Items(1).Properties("6152").Value = 11.7 * DPI 'Vertical extent for A4 3. لا ادري مقدار الضغط Compression ، لأنه للأرشفة يجب ان لا يكون هناك ضغط ، 4. وفي الواقع انك لما تأخذ صور jpg وتستعمل تقرير الاكسس لجمع هذه الصور ، ومن ثم تحولها الى pdf ، فأنت تعمل تغيير في حجم صور jpg ، وهذا يتنافى مع اصل الارشفة !! ارفقت لك برنامج يعمل كالتالي: تضع البرنامج في مجلد ، وتضع جميع صور jpg في نفس المجلد ، ثم انقر نقرتين على البرنامج ، وفي الشاشة السوداء اضغط على الرقم 1 من الكيبورد ، فتلقائيا يحول لك الصور الى ملف pdf ، وبنفس نقاوة كل صورة (جرب الصور اللي في المرفق) . طبعا لاحقا تقدر برمجيا ان تعطي البرنامج الامر عن طريق Shell مثلا 🙂 جعفر jpg to pdf.zip

اشكرك جزيل الشكر ووافر الاحترام

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