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

مشاركة مع الاخوة الاحبة ..... عسى أن يكون الكود قصيرا .... تفضل Aziz (2).rar

اهلا و مرحبا مستر أحمد وكل عام وانتم بخير في موضوعنا الحالي كنت ساكتب تعليق على حلول الزملاء من باب النقاش العلمي لكن تذكرت مجادلات علمية في موضوغ قديم مغلق بهذا المنتدى مغ بعض الشخصيات عمل زعل وتركت المشاركات منذ عدة سنوات وفي الايام دي وما يحدث من وفيات حولي زعلت أني تسببت لأحد في زعل بصرف النظر إن كان الخطأ منى أم من الغير. ايام الفريق العربي وشخصيات مثل الاخت زهراء والاستاذ جعفر لا تنسى وهنا بمنتدى اوفيسينا شخصيات كثيرة وجدتهم منذ العام 2008 منهم الاستاذة جعفر ايضا وابوخليل ومحمد صالح وتركي وغيرهم مش علشان علمهم بس هناك مقاييس اخرى لتمتلئ اعجابا بهم وتقديرا وتذكرهم حتى في مناقشاتك في الحياة العملية وكان السؤال الذي كنت اساله لنفسي وقد يسأله البعض لي عندما أحكي عنهم لماذا يساعدون ويعلمون الناس بها الشكل وبدون مقابل !! بالعكس احيانا يقوم البعض بمضايقتهم كما حدث مع الاخت زهراء والاجابة التي استنتجتها وقدرتها هي : أنه لوجه الله تعالى ، لا نريد منكم جزاء ولا شكورا واعتذر على الاطالة والابتعاد عن الاصلي . وكل عام وانتم بخير

جزاك الله خيرا اخى جمال @Gamal.Saad واخى @ابو تراب 💐 وهذه طريقه اخى باستخدام نماذج فرعيه كنت اعمل عليه New Microsoft Access Database (5) - Copy.accdb

بعد إذن الاستاذ ابو تراب والاستاذ أحمد الفلاحجي هذه فكرة للحل Dlookup_row Num in qry.accdb

جرب هذا الكود تسمية الورقة الأولى باسم "Infos" لسهولة نسخ الكود ولصقه دون مشاكل اللغة Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$A$2" And Target.Count = 1 Then Find_Hawiyya End If Application.EnableEvents = True End Sub '+++++++++++++++++++++++++++++ Sub Find_Hawiyya() Dim Inf As Worksheet, Act_sh As Worksheet Dim s_rg As Range, find_rg As Range Dim Inf_rg As Range Dim Targ_rg As Range Dim Where_rg As Range Dim m%, Ro%, x%, N% Set Inf = Sheets("Infos") Set s_rg = Inf.Range("A2") N = Sheets.Count m = 8 Set Inf_rg = Inf.Range("A7").CurrentRegion Inf.Cells(2, 2) = vbNullString If Inf_rg.Rows.Count > 1 Then _ Inf_rg.Offset(1).Resize(Inf_rg.Rows.Count - 1).Clear If s_rg = vbNullString Then Exit Sub For x = 1 To N If Sheets(x).Name = Inf.Name Then GoTo Next_x Set Act_sh = Sheets(x) Set find_rg = Sheets(x).Range("D:D") Set Targ_rg = find_rg.Find(s_rg, Lookat:=1) If Not Targ_rg Is Nothing Then Ro = Targ_rg.Row Inf.Cells(m, 2).Resize(, 18).Value = _ Sheets(x).Cells(Ro, 2).Resize(, 18).Value Inf.Cells(m, 1) = m - 7 m = m + 1 End If Next_x: Next x If m = 8 Then MsgBox "No Data To Exract": Exit Sub Set Inf_rg = Inf.Range("A7").CurrentRegion If Inf_rg.Rows.Count = 1 Then Exit Sub With Inf_rg.Offset(1).Resize(Inf_rg.Rows.Count - 1) .Borders.LineStyle = 1: .InsertIndent 1 .Font.Size = 16: .Font.Bold = True .Interior.ColorIndex = 19 End With Inf.Cells(2, 2) = Inf.Cells(8, "E") End Sub الملف مرغف Infomation.xlsm

جزاك الله خيرا اخى @ابو تراب

لا والله اخي احمد لكن فعلا ويندوز 10 افضل بمراااااااحل بعطيك ميزة اخرى امس او قبل اسبوع او اكثر فتحت ملفات كثيرة واليوم تريد الرجوع لاحد الملفات ونسيت اسمه لا مشكلة بكل سهول انقر على الايقونة ويظهر لك عملك والملفات التي عملت عليها كل يوم على حده يكفي ولا نزيد 😃

السلام عليكم 🙂 عند تنصيب الاوفيس 2019 و 365 ، فإن التنصيب الافتراضي هو نواة 64 بت ، بينما سابقا كانت مايكروسوفت توصي بتنصيب الاوفيس نواة 32 بت (بغض النظر عن نظام الوندوز) : لذا فقد آن الأوان ان تكون برامجنا تعمل على النواتين 32/64 بت 🙂 اسهل طريقة لتنصيب اكثر من نسخة من البرامج ، هو استخدام الكمبيوتر الافتراضي 🙂 رجاء مشاركتنا تجربتك في هذا المجال 🙂 جعفر

Storing_Pictures.accdb

تفضل ضع الكود <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"> <ribbon startFromScratch="false"> <tabs> <tab id="customTb" label="MY NEW TAB" visible="true"> <group id="dbGroup" label="’My Group"> <button idMso="Cut" label="Cut" size="large" /> <button idMso="ExportExcel" label="Export For EXC" size="large" insertBeforeMso="Cut" /> <button id="RunMacro" label="Open" size="large" imageMso="ViewsFormView" onAction="OpenForm"/> </group> </tab> </tabs> </ribbon> <!--كود إيقاف جميع أوامر file بداية--> <backstage> <button idMso="FileCloseDatabase" visible="false"/> <button idMso="SaveObjectAs" visible="false"/> <button idMso="FileSaveAsCurrentFileFormat" visible="false"/> <button idMso="FileOpen" visible="false"/> <button idMso="FileSave" visible="false"/> <tab idMso="TabInfo" visible="false"/> <tab idMso="TabRecent" visible="false"/> <tab idMso="TabNew" visible="false"/> <tab idMso="TabPrint" visible="true"/> <tab idMso="TabShare" visible="false"/> <tab idMso="TabHelp" visible="false"/> <button idMso="ApplicationOptionsDialog" visible="false"/> <button idMso="FileExit" visible="false"/> <button id="btnPrintPreviewClose" isDefinitive="true" label="Close Preview" imageMso="PrintPreviewClose" onAction="OnActionClose"/> </backstage> <!--كود إيقاف جميع أوامر file نهاية--> </customUI>

راجع براحتك اخى @ازهر عبد العزيز واسئل براحتك فكلنا اخوان واتعلم معك من اساتذتنا جزاهم الله خيرا وجزاه الله خيرا اخوانى واساتذتى @ابو تراب و @Gamal.Saad وتقبل الله منهم صالح الاعمال💐 بالتوفيق اخى

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

اهلا بك اخى ومرحب بعودتك للمشاركه معنا وخفف عن نفسك وانسى الماضى واستغفر لنفسك ولهم ولا تنسانا بارك الله فيك وكلنا اخوه فالله قبل كل شىء تجمعنا هنا من اجل هدف واحد وهو ان نتعلم ونستفيد ونفيد اخواننا فى الله بما من الله علينا من فضله وعلمه بارك الله فيك ومرحبا بعودتك مره اخرى اخى 💐 وتقبل الله منكم صالح الاعمال ونعود للمشاركه مع اخى @فايز.. و سؤال الاخ @adnan gharbi انظر المرفق ووافنا بالنتيجه بالتوفيق الاستعلام المطلوب.accdb

تم التعديل اذا كان الرقم وحيداً يكتب بالعربية واذا كان مصحوباً مع اي شيء اخر اكسل يتعبره نصاّ لذلك لا يدرجه بالعربية Information_Advanced_Ar.xlsm

تم التعديل على الكود كما تريد Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$A$2" And Target.Count = 1 Then If Target = vbNullString Then Find_Hawiyya_ALL Else Find_Hawiyya End If End If Application.EnableEvents = True End Sub '+++++++++++++++++++++++++++++ Sub Find_Hawiyya() Dim Inf As Worksheet, Act_sh As Worksheet Dim s_rg As Range, find_rg As Range Dim Inf_rg As Range Dim Targ_rg As Range Dim Where_rg As Range Dim m%, Ro%, x%, N% Set Inf = Sheets("Infos") Set s_rg = Inf.Range("A2") N = Sheets.Count m = 8 Set Inf_rg = Inf.Range("A7").CurrentRegion Inf.Cells(2, 2) = vbNullString If Inf_rg.Rows.Count > 1 Then _ Inf_rg.Offset(1).Resize(Inf_rg.Rows.Count - 1).Clear 'If s_rg = vbNullString Then Exit Sub For x = 1 To N If Sheets(x).Name = Inf.Name Then GoTo Next_x Set Act_sh = Sheets(x) Set find_rg = Sheets(x).Range("D:D") Set Targ_rg = find_rg.Find(s_rg, Lookat:=1) If Not Targ_rg Is Nothing Then Ro = Targ_rg.Row Inf.Cells(m, 2).Resize(, 18).Value = _ Sheets(x).Cells(Ro, 2).Resize(, 18).Value Inf.Cells(m, 1) = m - 7 m = m + 1 End If Next_x: Next x If m = 8 Then MsgBox "No Data To Exract": Exit Sub Set Inf_rg = Inf.Range("A7").CurrentRegion If Inf_rg.Rows.Count = 1 Then Exit Sub With Inf_rg.Offset(1).Resize(Inf_rg.Rows.Count - 1) .Borders.LineStyle = 1: .InsertIndent 1 .Font.Size = 16: .Font.Bold = True .Interior.ColorIndex = 19 End With Inf.Cells(2, 2) = Inf.Cells(8, "E") End Sub '++++++++++++++++++++++++++++++++++++ Sub Find_Hawiyya_ALL() Dim Inf As Worksheet Dim s_rg As Range Dim Inf_rg As Range Dim Where_rg As Range Dim m%, t%, x% Dim Dic As Object, ky Dim arr(11) Set Inf = Sheets("Infos") Set s_rg = Inf.Range("A2") Set Dic = CreateObject("Scripting.Dictionary") '============================ Set Inf_rg = Inf.Range("A7").CurrentRegion If Inf_rg.Rows.Count > 1 Then _ Inf_rg.Offset(1).Resize(Inf_rg.Rows.Count - 1).Clear For t = 1 To 12: arr(t - 1) = t & "": Next m = 8 '======================= If s_rg <> vbNullString Then Exit Sub For x = 1 To Sheets.Count If IsError(Application.Match(Sheets(x).Name, arr, 0)) Then _ GoTo Next_x Set Where_rg = Sheets(x).Range("a1").CurrentRegion If Where_rg.Rows.Count = 1 Then GoTo Next_x Set Where_rg = Where_rg.Offset(1).Resize(Where_rg.Rows.Count - 1) For t = 1 To Where_rg.Rows.Count Dic.Add (t - 1), Where_rg. _ Rows(t).Cells(2).Resize(, 18).Value Next t For Each ky In Dic.keys Inf.Cells(m, 2).Resize(, 18) = Dic(ky) Inf.Cells(m, 1) = m - 7 m = m + 1 Next ky Next_x: Dic.RemoveAll Next x Set Inf_rg = Inf.Range("A7").CurrentRegion If Inf_rg.Rows.Count = 1 Then Exit Sub With Inf_rg.Offset(1).Resize(Inf_rg.Rows.Count - 1) .Borders.LineStyle = 1: .InsertIndent 1 .Font.Size = 16: .Font.Bold = True .Interior.ColorIndex = 35 End With Inf.Cells(2, 2) = "ALL" End Sub الملف مرفق Information_Advanced.xlsm

تفضل Private Sub CommandButton2_Click() ActiveSheet.PrintOut From:=Range("B8"), To:=Range("C8"), Copies:=1, Collate:=True End Sub تواتي 12.xlsm

بالعكس ، فمثل هذه المعلومات غير متداولة في المنتدى هنا ، ومن المهم ان يعرفها الاعضاء 🙂 نعم للشركات اللي تصنع الكمبيوترات ، ولكن نسخة 32 بث بتكون لاتزال موجودة للأفراد 🙂 وعلى العموم ، الوندوز نواة 64 بت لا يغير من موضوعنا شيء ، ولكنه مفيد بأننا نقدر ان نثبت الاوفيس نواة 32 بت او 64 بت عليه 🙂 ومتابع 🙂 جعفر

هلا اخي لا ادري اذا هذا ينفع..لاحظ رقم 6 مكرر New Microsoft Access Database (5) - Copy.accdb

مايكرو توصي باالاتي كحد ادنى 16 غيغابايت لنظام تشغيل 32 بت 32 غيغابايت لنظام تشغيل 64 بت وانا انصح بتركيبه على هارد مستقل لاستخدام المساحة الزائدة كذاكرة ظاهرية وهي مساحة يستخدمها النظام من مساحة الهارد لتخزين البيانات بشكل مؤقت وايضا استخدام نفس الهارد بدون تقسيم خطر ويتلف ملف الاقلاع لذا اذا كانت السعة التخزينية لديك قليلة او لديك ملفات مهمة في الجهاز لا انصحك بالتهور ايضا حجم الرام لديك مايكرو حددت 1 جيجا لتركيب ويندوز 10 ولكن تجربتي 8 جيجا كافية بشكل جيد وانصح بـ 16 جيجا الله يستر لا يزعل علينا الاستاذ @jjafferr قلبنا الموضوع من من اوفيس الى ويندوز 👀

حياك الله اخي @فايز.. تغيير في حقل الجنس Private Sub GENRE_AfterUpdate() If Not IsNull(Me.GENRE) Then Dim lastID As Integer Dim lastCode As String lastID = Nz(DMax("Units_AutoID", "TabUnitsTeachers", "UNITS = '" & Me.GENRE.Value & "'"), 0) lastCode = Nz(DLookup("CODE", "TabUnitsTeachers", "UNITS = '" & Me.GENRE.Value & "' AND Units_AutoID=" & lastID), vbNullString) If lastCode = vbNullString Then lastCode = Switch(Me.GENRE.Value = "ÐßÑ", "01-000", Me.GENRE.Value = "ÃäËì", "02-000") End If Me.ID_TEACHER.Value = Left(lastCode, 3) & Format(Val(Right(lastCode, 3)) + 1, "000") Else Me.ID_TEACHER.Value = vbNullString End If End Sub وتغيير بعد الحفط Private Sub Form_AfterUpdate() If Not IsNull(Me.GENRE) And Not IsNull(Me.ID_TEACHER) Then DoCmd.RunSQL "INSERT INTO TabUnitsTeachers (UNITS, Code) VALUES ('" & Me.GENRE.Value & "','" & Me.ID_TEACHER.Value & "')" End If End Sub

على كل حال ميكروسوفت سوف توقف اصدار انظمة ويندوز 32 بت بشكل رسمي واخر اصدارة من ويندوز تدعم 32 بت ستكون اصدارة مايو 2020 وتحمل رقم 2004 اي كافة اصدارات ويندوز بعد 2004 ستكون 64 بت المعالجات Core 2 Duo فاحدث جميعها تدعم 64 بت وبالتالي لن تكون هناك مشاكل الا لاصحاب معالجات بنتيوم 4 فاقل اعتقد هذا الموضوع جاء في الوقت المناسب 😎

تم معالجة الأمر الشيت "شيت تبيض الدور الأول" يمكن اخفائها اذا اردت أم يمكن حذفها نهائياً لكن Sheet1 لا يمكن الاستغناء عنها لأنها تحتفظ بالديباجة اذا زاد او نقص عدد الطلاب يمكن ازالة الديباجات بواسطة الماكرو المخصص لهذه الغاية (الزر Del Dibaja ) تم التعديل على البيانات (دون صفوف فارغة) و من ثم تقسيم الديباجات على الصفحة حسب الرقم الذي تريده من الــ Input Box الكود الجديد Sub salim_rows() Dim t%, lr%, x%, z%, a% Dim my_rg As Range, k% Dim In_box, ro% If ActiveSheet.Name <> "Salim" Then GoTo End_Me Application.ScreenUpdating = False del_Empty_rows In_box = Application.InputBox("How Many Rows", , 20) a = In_box - 1 'number of rows for every group z = 3 'number of rows to be insert every time x = 7 'first row to begine If a <= 0 Then Exit Sub t = x + a + 1 If z > 5 Then z = 5 lr = Cells(Rows.Count, 2).End(3).Row On Error Resume Next On Error GoTo 0 Do Until Cells(t, "B") = "" Rows(t).Resize(z).Insert Sheets("sheet1").Range("My_DEB").Copy _ Cells(t, 1) t = t + a + z + 1 Loop ro = ActiveSheet.Cells(Rows.Count, 2).End(3).Row Rows(ro + 1).Resize(z).Insert Sheets("sheet1").Range("My_DEB").Copy _ Cells(ro + 1, 1) End_Me: Application.ScreenUpdating = True End Sub '++++++++++++++++++++++++++++ Sub del_Empty_rows() On Error Resume Next Dim lr%: lr = Cells(Rows.Count, 2).End(3).Row Range("B" & lr + 1).Resize(20).EntireRow.Delete Range("Ba7:Ba" & lr).SpecialCells(4).EntireRow.Delete On Error GoTo 0 End Sub الملف من جديد Najehoun.xlsm_2.xlsm

تفضل Copy of Book12.xlsx

تفصيل الأول : جدول التصنيفات يعتبر اساس وان شئت قل هو القلب النابض للنظام ، يسجل فيه كل صغيرة وكبيرة تخص المنتج : الكود المصنعي (وهو المعرف وهو صورة الباركود التي تظهر على المنتج) الكود الداخلي ( تشترك فيه جميع اجزاء المنتج : الكرتونة واجزاءها) اسم الصنف / نوعه / وحدة1 / وحدة2/وحدة3 وهكذا لا مشاحة في التسميات .. فاسم الصنف هو الذي يظهر في فاتورة الزبون مثلا : شكولا حلواني كرتون ، شكولا حلواني علبة ... اما الوحدات فهي حقول رقمية يثبت بها العدد على اعتبار 1 هو الكرتون و 2 هو العلبة وهكذا ايضا هناك حقول اخرى كثيرة يجب ادراجها في سجل المنتج ولكن الذي يهمنا هنا هو ما ذكرناه اعلاه التفصيل الثاني : اعتقد ان تفصيله ظهر من خلال التفصيل الاول .. كيف ؟ عبر الكود الداخلي يتم التجميع والتصفية والتحويل

السلام عليكم ورحمة الله وبركاته من المعروف ان الاوفيس يأتي بصيغة 32 بت وصيغة 64 بت ، ونظام التشغيل وندوز كذلك يأتي بصيغة 32 بت و 64 بت ، وقد يختلط الأمر على بعض الاشخاص فيعتقدون بأنه يجب تنصيب الاوفيس 64 بت على الوندوز 64 بت ، بينما في واقع الامر ، فإن مايكروسوفت توصي بإستخدام الاوفيس 32 بت على جميع نظم التشغيل ، الرابط التالي من مايكروسوفت يوضح هذا: https://technet.microsoft.com/en-us/library/ee681792.aspx وهناك حالات خاصة لتنصيب الاوفيس 64 بت (كذلك المعلومة موجودة في الرابط اعلاه) ، وهذه الحلات لا تنطبق على الاكسس. ومن المعروف انه اذا كان لديك الاوفيس 64 بت ، فإن معظم البرامج السابقة والتي تحتوي على دالة API المحتوية على 32 بت ، فإن البرنامج لن يشتغل وسيعطيك أخطاء لذلك ، وكما يقول المثل: الباب اللي يجيك منه ريح ، سده واستريح فاذا عندك اوفيس 64 بت على جهازك ، فآن الاوان ان تمسح/تلغي تنصيبه ، وتنصب اوفيس 32 بت ---------------------------------------------------------------------------------------------------------------- تحديث بتاريخ: 20-5-20 في الصفحة الرسمية لمايكروسوفت بتاريخ 8/3/2019 ، فإن مايكروسوفت الآن توصي بتنصيب الاوفيس نواة 64 بت ، وهي النواة التي يتم تنصيبها تلقائيا في الاوفيس 2019 والاوفيس 365. طبعا لا يمكن تنصيب الاوفيس نواة 64 بت ، إلا على الوندوز نواة 64 بت. شو فائدة هذه الرسالة لنا؟ اعتقد من الافضل ان نبدأ بتحويل برامجنا الى النواة 64 بت ، فقد يأتي اليوم الذي تُلغى في نواة 32 بت جعفر

أنا بدأت بعدك مع Dos5 وعلى ما أتذكر كانت هناك أقراص 5.25 المرنة للتخزين ثم كانت الثورة التكنولوجية بأقراص 3.5 المرنة ورحلة طويلة مع أوامر وبرمجة واستخدام لم يكن معروفاً وقتها للغة العربية في تلك البيئة وبالفعل win10 64bit المفضل لدي ، لكن متعود على وجود أكثر من جهاز كمبيوتر بالمنزل وبعضها به أكثر من HD وقد يحتوى الهارد ديسك على نظام أو أكثر.

شكراً جزيلاً اخي الكريم Gamal.Saad على المرور الكد يعمل بامتياز بارك الله بك

تقضل Information_Advanced_Ar_date.xlsm

السلام عليكم تم التعديل على قيم العمود A (بالمعادلات) من الورقة 111 (ورقة البيانات) والتعديل على كود "طباعة الكل" بما يفي الغرض المطلوب... برنامج شهادات نصف التيرم صف ثانى.xls

فعلا عملاق .. هههههههههههههههه

الاساتذة @أحمد الفلاحجى و Gamal.Saad افكار جميلة جدابالنسبة لمثال احمد الفلاحجي فكرة اكثر من رائعة ما شاء الله اما الاستاذ Gamal.Saad انت صاحب فكرة استعلام التوحيد ثم تاتي لفكرة ثانية يعني شلون ... راسي افتر فكرة اجمل من الاخرة ارجوكم تحملوني لحين مراجعت امثلتكم وتحملوني اذا كانت هناك اسئلة اخرى جزاكم الله عني كل خير

وجزاكم أخي أعتقد أن طريقتك هذه أسهل وفكرة جميلة

الله يرضى عليك تسلم طلب اخير - وهو ان تكون الارقام من الانكليزي 1234567890 الى العربي واسأله تعالى ان يوفقك ويرزقك على المعروف الذي تقدمه لتسهيل مهمة العمل وجعلها اكثر دفة وسهولة جزيت خيرا

تسلم يداك .. ما شاء الله تبارك الله .. الجميل في الموضوع : تفريغ الخانات بعد إضافة البيانات . وهذا ما لم يكن موجود قبل لمساتك الحلوة ..

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

جزاكم الله خيرا لحسن ظنكم بي أنا فعلا انشغلت ولكن ليس كما تفضلتم بالعشر الأواخر (وياليتني فعلت وها قد انفلت منا الشهر ) تقبل الله منا ومنكم صالح الأعمال وجعلنا واياكم ممن اعتق الله رقابهم من النار في هذا الشهر الكريم هل تعنون بتوضيحكم السابق انه سيتم التعامل مع الصنف كرتون والصنف مغلف علي كونه صنف واحد من خلال الكود المتشابه علي يسار البار كود بين الكرتون وما بداخلها من مغلفات ولكن ما ظهر لي من الصورة أن الصنف تم ادخاله بالوحدة الاجمالية الكرتون وتم احتساب الكمية الاجمالية وفقا للكمية المخزنة التي تعادل الكرتون من هذا الصنف مثلا تم شراء 20 كرتونة كاتشب وتم تخزين الكمية 480 علي اعتبار ان الكرتون يحوي 24 عبوة أعتقد أن الأمر بحاجة لمزيد من التوضيح ( بنسبة لصعيدي مثلي 😀) لو افترضنا أننا سننشأ module سيقوم بمعالجة كود الصنف واستخراج كونه كرتون أو مغلف داخل الكرتون أو ظرف داخل المغلف فما ضابط لهذا والأكواد مختلفة من صنف لصنف كما هو واضح من ردكم الكريم فضلا عن كون هناك بعض الاصناف التي لن نجد لها تكويد أصلا لا علي الكرتون أو ما بداخله (هذا يحدث أحيانا في بعض السلع المحلية😨) أعتذر علي الاطالة وجزاكم الله عنا خيرا

نسخة 32 بت ستبقى تعمل وتدعم ولكن لن يكون هناك خيار الحصول على اصدار جديد من ويندوز 32 كما حصل عند الانتقال من ويندوز 3x الى 95 والذي كان يعمل على 32 ويدعم 16 بت وايضا الاصدارات الحالية ذات 64 تدعم برامج 32 بت صحيح ولكن اصدار نسخة 64 بت فقط حتى لو كان للاجهزة الجديدة سيدفع الشركات للاتجاة نحو 64 بت وسياتي يوم يكون مصير 32 مثل 16 وتغيير نصيحة مايكروا من التشجيع على استخدام 32 بت الى 64 بت مع توجهاتها لما بعد اصدار 2004 ليس من فراغ الحقيقة لا انصحك بتنزيله حاليا اخي احمد

هلا اخي هذه محاولة Aziz.accdb

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

جميل جدا واستعلام واحد شيئ ملفت للنظر ربما لأني تركت الأكسس منذ فترة وأستأذنكم في طرح حل آخر ولا يهم إن كان المطلوب أم لا لأن غرضي من الطرح هو التعلم من سؤال عن إمكانية اختصار أربعة استعلامات صممتها للوصول للشكل بملف الوورد الذي أرفقه السائل - طبعا كثير وأربعة استعلامات أخرى لمطلوب لم يطلبه السائل هههههههه وقد استعنت بدالة من هذا المنتدى لعمل المطلوب الغير مطلوب Vibrators3.accdb

شكرا اخي الفاضل هدية بسيطة تقديرا لمجهودك

هلا اخي جرب المرفق New_Microsoft_Access_Database.accdb

يمكن تمثيل الخط الزمني للقيم بالجدولين مركز الخليج Chart.accdb

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

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

أشكرك أخي عبد الفتاح على مساعدتي ألف تحية مني إليك لدي استفسار آخر من فضلك : عند عمل زر للفورم في ورقة "ابدأ" و اقوم بالترحيل لورقة " قائمة التلاميذ" او " بيانات التلاميذ" يظهر خطأ رغم أني غيّرت في الكود ؟؟؟ Nouveau Feuille de calcul Microsoft Excel - Copie.xlsm

بعد اذن الاستاد الرائد قد يساعدك هذا الكود 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

شكرا جزيلا أستاذ أحمد الفلاحجى الله يعطيك العافية جزاكم الله خيرا

تفضل help.xlsm

السلام عليكم بعد اذن الاستاذ الكبير عبدالله كتب لك كود بسيط لعله يعجبك sumcolor.rar