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

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

برنامج الموارد البشرية HR "مفتوح المصدر" يحتوى على التالي : -بيانات الموظف . -الإجازات . - الأذنونات . - تسجيل الحضور يدوياً . - الخصومات . - السلف . - المكافأت . - تقيييم الموظف . - ساعات إضافية . - تقارير. - متابعة الحضور والانصراف . - تسجل الحضور والانصراف بشكل آلي . - تسجل الحضور بشكل يدوي . وخيارات أخرى . وهذا البرامج من تطويري وجدت جداوله في موقع خارجي . لا تنسونا من خالص الدعاء ،،، HR.rar

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

تقضل Information_Advanced_Ar_date.xlsm

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

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

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

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

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

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

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

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

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

جزاك الله خيرا استاذ محمد اضافه رائعه وسوف ولكن هذه تخص ويندوز 10 هل يوجد ما يخص ويندوز 7 ؟ اعمل فعليا على اصدار 2003 و 2016 حاليا والحمد لله مفيش مشاكل رحله طويله ماشاء الله من قبل ولادتى بعام هههههههههههه شكلك بتجر رجلى لويندوز 10 اخى واستاذى خالد 😀 لم اعمل الا على اكس بى وويندوز 7 وويندوز 10 بالعمل اتعامل معه ولكن مش مريحنى زى ويندوز 7 وحتى مع تجربتى معه بالمنزل ووجدته يستهلك الانترنت بسبب التحديثات المستمره اتوماتك وقبل ان اعلم كيفيه ايقاف التحديث المستمر وسبب لى ارهاق كثيرا فالوصول لبعض الشاشات وتخصيصات الويندوز فلم استرح للعمل عليه لدرجه اننى بطلب من الدعم بالعمل تحميل ويندوز 7 على الجهاز الذى اعمل عليه ولكن مطنشين ربما قلق من الدعم الرئيسى وفحص الانظمه ربما سوف اقوم بتجربته مره اخرى بالتوفيق اساتذتى

نعم اخي احمد هذا اعلان مايكرو بخصوص ويندوز 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 نواة 64 بت ثم نصبت الوندوز 32 بت ، صار لي مجموعة من المشاكل لاحقا ، فكان الكمبيوتر يشتغل تمام معظم الاحيان ، ولكن بعض الاوقات ما يشتغل ، وبالتالي اضطررت ان انصب نواة واحدة فقط !! ما ادري ، يمكن الوندوز 10 في اول ايامه كان فيه مشاكل !! جعفر

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

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

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

السلام عليكم ورحمة الله لعلها تكون قائمة من ضمن القوائم التي يتم عليها "الفرز الخاص"... إذا كانت موجودة من ضمن هذه القوائم فيكفي القيام بحدفها... راجع الملف التنفيذي المرفق (وضعت خطأ في القائمة بدل حرف "الميم" حرف "الفاء").. 555.rar

التعامل مع بيانات الويب من خلال FTP: إستقبال بيانات من موقع معين سوف نقوم في هذا الدرس إن شاء الله بشرح طريقة جلب بيانات من الويب من دون اللجوء إلى المتصفح تنبيه: في هذا المجال ليس لدي أي خبرة و قد أعتمدت على البحث في الويب لجمع المعلومات. فلربما أخطئ في ذكر أحد المصطلحات لذلك من لديه دراية بهذا الموضوع و راني أخطئ فالرجاء أن يصوبني. بروتوكول FTP: FTP هي اختصار لمجموعة كلمات File Transfer Protocol، وهي تعني بروتوكول نقل الملفات، وهذه الخدمة هي إحدى تطبيقات TCP/IP التي تجعل من الممكن نقل الملفات بين أجهزة الحاسب الآلي المختلفة و المرتبطة بشبكة الإنترنت. ينقسم نقل الملفات إلى نوعين: 1 ـ تنزيل الملفات Download: وهو جلب الملفات من الكمبيوتر المضيف Host إلى جهازك المحلي Local. و نستخدم الأمر Get 2 ـ رفع الملفات Uplaod: وهو إرسال الملفات من جهازك المحلي Local إلى الجهاز الخادم Host. و نستخدم الأمر Put - كل طلب يرسل Request يتم من خلاله استقبال رد Response أوامر FTP: هذه بعض الأوامر المستخدمة في بروتوكول FTP و التي سنحتاجها أو سنعمل عليها. 1-Post: يستخدم لارسال معلومات من المستخدم مثال: إنشاء موضوع جديد أو تسجيل الدخول كل هذا عبر Post Request 2-Get: يستخدم هذا الأمر لتنزيل ملف ما من جهاز الخادم أو عرض صورة أو صفحة. مثال: أقوم بإرسال طلب و استقبل ردًا Response يحتوي على أكواد html للصفحة 3-Put: يستخدم لرفع الملفات إلى جهاز الخادم 4-Open: يستخدم لإنشاء إتصال جديد مع الخادم 6-Close: يستخدم لإنهاء الإتصال مع جهاز الخادم مثال تطبيقي: سوف نستخدم هذا الموقع: https://uk.investing.com/rates-bonds/financial-futures سوف نقوم بإستيراد بيانات جدول من هذه الصفحة إلى جدول موجود في الملف و قد ربطه بمربعات نص لنلاحظ تنزيل البيانات هذا الكود المستخدم: Dim html As HTMLDocument, hTable As HTMLTable Dim Url As String Url = "https://uk.investing.com/rates-bonds/financial-futures" Set html = New HTMLDocument With CreateObject("MSXML2.XMLHTTP") .Open "GET", Url, False .send html.body.innerHTML = .responseText End With Set hTable = html.getElementById("cr1") For i = 1 To hTable.rows.length - 1 DoCmd.GoToRecord , , acNewRec Me.id = hTable.rows(i).cells(1).innerText Me.dd = hTable.rows(i).cells(2).innerText Me.t1 = hTable.rows(i).cells(3).innerText Me.t2 = hTable.rows(i).cells(4).innerText Me.t3 = hTable.rows(i).cells(5).innerText Me.t4 = hTable.rows(i).cells(6).innerText Me.t5 = hTable.rows(i).cells(7).innerText Me.t6 = hTable.rows(i).cells(8).innerText Next i شرح الكود: تعريف كائنات html Dim html As HTMLDocument, hTable As HTMLTable إنشاء إتصال جديد عبر السرفر MSXML2.XMLHTTP و إرسال الطلب: With CreateObject("MSXML2.XMLHTTP") .Open "GET", Url, False .send إستقبال الرد على شكل صفحة html: html.body.innerHTML = .responseText استخراج البيانات من الجدول الموجود في الرد الذي استقبلناه وقد قمنا بشرح التعامل مع الجداول في الجزء الأول بالتفصيل: Set hTable = html.getElementById("cr1") For i = 1 To hTable.rows.length - 1 DoCmd.GoToRecord , , acNewRec Me.id = hTable.rows(i).cells(1).innerText Me.dd = hTable.rows(i).cells(2).innerText Me.t1 = hTable.rows(i).cells(3).innerText Me.t2 = hTable.rows(i).cells(4).innerText Me.t3 = hTable.rows(i).cells(5).innerText Me.t4 = hTable.rows(i).cells(6).innerText Me.t5 = hTable.rows(i).cells(7).innerText Me.t6 = hTable.rows(i).cells(8).innerText Next i استخدام ftp.rar

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

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

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

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