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

مشاركة مع الاخوة الاحبة ..... عسى أن يكون الكود قصيرا .... تفضل 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 هو العلبة وهكذا ايضا هناك حقول اخرى كثيرة يجب ادراجها في سجل المنتج ولكن الذي يهمنا هنا هو ما ذكرناه اعلاه التفصيل الثاني : اعتقد ان تفصيله ظهر من خلال التفصيل الاول .. كيف ؟ عبر الكود الداخلي يتم التجميع والتصفية والتحويل

السلام عليكم : في الفورم الموجود بالمرفق أريد ترقيم تلقائي – للموظف- بشرط يكون الترقيم حسب الجنس فيكون ترقيم الذكور يبدأ: 001-01 وترقيم الاناث يبدأ كالتالي:001-02 ويكون الترقيم عند الخروج من الحقل الجنس ويستمر الترقيم ملاحظة: يوجد بالمرفق جدول TabUnitsTeachers فيه شكل الترقيم حيث يكون الترقيم كالتالي: الكود الجنس 01-001 ذكر 01-002 ذكر 02-001 أنثى 02-002 أنثى 02-003 أنثى Aziz.rar

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

تقضل Information_Advanced_Ar_date.xlsm

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

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

الفاصلة على حسب اللغة المختارة في الاعدادات الاقليمية

اخي عبد الفتاح بارك الله فيكِ وجزاكِ الله خير الجزاء دمتِى برضى الله وحفظه ورعايته

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

حبيبي يا استاذى اكثر الله خيرك وبارك لك الله يبارك لك يارب ويديك الصحة والعافية حبيبي والله

الآن فهمت عليك ماذا تريد (كي لا تظهر الاصفار في اي خلية ) بدون فورمات سيلس استبدل هذا السطر في الكود R.Cells(k, y).Value = My_sum: My_sum = 0 الى R.Cells(k, y).Value = IIf(My_sum = 0, "", My_sum): My_sum = 0

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

أخي الفاضل . هل ريد الربط في هذا النموذج ؟؟

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

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

نعم اخي احمد هذا اعلان مايكرو بخصوص ويندوز 7 اعتبارًا من 14 يناير 2020، سيستمر جهازك الذي يعمل بنظام التشغيل Windows 7 في العمل، ولكن لن تقوم Microsoft بتقديم الخدمات التالية:: الدعم الفني لأي مشاكل تحديثات البرنامج تحديثات الأمان أو إصلاحه تجربتي تقريبا جربت جميع انظمة مايكرو رحلة طويلة من عام 1982 من اصدار دوس3 الى دوس5 ثم ويندوز1 و 3 و3.1 و3.11 و95 و98 كلا الاصدارين وملينيوم و2000 و2003 ستاندر اديشن واكس بي وفيستا و7 و8 و8.1 واخيرا 10 لم اجد افضل من 10 لاستقرار النظام والوضع الليلي ووضع الطيران وكذلك 7 للتوافق مع الاجهزة والبرامج القديمة ولكن ثغراته كثيرة ولم اجد اسوء من فيستا ثقيل ومشاكلة لا تنتهي اضافة رائعة استاذنا الفاضل نعم استاذي لا يمكن تحميل اصداري اوفيس مختلفتي النواة وهذا مذكور في وثائق مايكرو هذا النص من موقع مايكرو احرص على أن تكون جميع إصدارات Office التي تريد تثبيتها من الإصدار 32 بت أو 64 بت. لا يمكنك تثبيت مزيج من الإصدارين. اطلع على الخطأ "تعذر تثبيت Office‏ (64 بت أو 32 بت‏)" عند محاولة التثبيت.

من تجربتي ويندوز 10 احيانا عند تركيب ويندوز 10 اخر يحصل مشكلة عند الاقلاع المشكلة احيانا تختفي شاشة اختيار النظام عند بدء التشغيل والمشكلة الاكبر عندما يرفض الجهاز الاقلاع يمكن حل المشكلة باستخدام EasyBCD تحميل البرنامج مع اخلاء مسئوليتي لكون البرنامج قد يعطل عمل النظام لذا وجدت ان الافضل تحميل ويندوز 7 64 بت ثم تحميل ويندوز 10 64 بت ولكون لدي وفرة في محركات الاقراص الفعلية فانني اضع لكل نظام تشغيل قرص صلب مستقل واحد لويندوز 10 والثاني لويندوز 7 والثالث ل Ubuntu احتياجي لعدة انظمة ليس بسبب اوفيس وانما لوجود مبرمجة ملتي برجرامر وسيزون انترفيس لا يتوافقون مع ويندوز 10

وهذا بالضبط اللي عملته انا في البداية ، حيث من المعروف ان الوندوز يسمح بتنصيب اكثر من وندوز على الجهاز الواحد ، ولكن من تجربتي لما نصبت الوندوز 10 نواة 64 بت ثم نصبت الوندوز 32 بت ، صار لي مجموعة من المشاكل لاحقا ، فكان الكمبيوتر يشتغل تمام معظم الاحيان ، ولكن بعض الاوقات ما يشتغل ، وبالتالي اضطررت ان انصب نواة واحدة فقط !! ما ادري ، يمكن الوندوز 10 في اول ايامه كان فيه مشاكل !! جعفر

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

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

تفضل اخي اسم الورقة غير صحيح لذلك يظهر الخطا تم معالجة الامر 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

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

سلمت أناملكما ^_^

الطريقة التي وضعها استاذنا الفاضل ابو تراب صحيح واكثر احترافية واليك طريقة اخرى في نموذج الدخول وضعنا مربع نص مخفي اسمه tx2 وجعل قيمته تساوي يمكن الاستغناء عن الحقل المخفي ووضع كود في نموذج Employees يغني عن الحقل ولكن هذه الطريقة اعتقد انها اسهل Me.tx2 = cboUserName.Column(1) في نموذج Employees الحقل نص0 جعلنا قيمته تساوي [Forms]![Login]![tx2] ولاضافة اسم المستخدم للجدولCard_print للحقل user وضعنا في حدث بعد التحديث للحقل emp_id او لاي حقل اخر Me.user = Me.نص0 الملف مرفق ShowUser.accdb

وعليكم السلام 🙂 بالاضافة الى شرح اخوي خالد ، جرب التالي: 1. اعمل زر جديد ، 2. بدل ان تكون الصورة مضمنة Embeded ، اجعلها مربوطة linked . لاحظت انه هذه العملية تزيل البرواز حول الصورة ، فقد يكون هذا قصدك !! جعفر

السلام عليكم 🙂 هذه جميع مكتبات مايكروسوفت ، بصيغة نواة 32bit ومقابلها نواة 64bit ، في ملف Win32API_PtrSafe.TXT https://www.microsoft.com/en-us/download/details.aspx?id=9970 وقد ارفقت الملف لسهولة الوصل اليه 🙂 جعفر Win32API_PtrSafe.zip