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

Kabo223412 أين انت من هذه الإجابة الممتازة؟!!! أين الضغط على الإعــــجـــــاب , وكما اتفقنا ان هذا أقل ما يقدم لمن له الفضل عليك بعد ربنا فى حل مشكلتك وتفريج كربتك ؟!!!💙

مجرد رأي : ملف الاكسل واحد ... صحيح عند تصدير الفصل أ ثم تصدير الفصل ب ثم ج د هـ تجد مشكلة في اسماء الطلاب وتداخلها ... فتضطر لمسح ملف الاكسل كل مرة ( ماذا لو جعلت ملف الاكسل قالب ) تكون افضل وفي كل مرة تصدير يطلب منك البرنامج اسم جديد ... اقضل انظر للمرفق الجديد وملف الاكسل الموجود فيه هو قالب لا يتغير بل يطلب منك اسم لكل تصدير وموقع للتصدير .... جرب المرفق وأعلمنا بالنتيجة .... kanory.rar

جرب المرفق شهر10.xlsm

جرب هذا الكود للترحيل الى Data (الزر الاخضر) الترحيل لا يتكرر الغرقة المحجوزة تكتب فيها "Ok" Option Explicit Private D As Worksheet Private Inv As Worksheet Private D_rg As Range, Inv_rg As Range Private where_D As Range Private where_Inv As Range Private Ro_D#, ro_Inv#, m#, col# '++++++++++++++++++++++++++++++++++ Sub From_Inv_to_Sh_data() Set D = Sheets("Data") Set Inv = Sheets("Invoice") Dim Rehla: Rehla = Inv.Cells(7, "E") 'B Dim Dt: Dt = Inv.Cells(8, "D") 'C Dim ReH_Size: ReH_Size = Inv.Cells(9, "D") 'd Dim Hafila: Hafila = Inv.Cells(9, "F") 'E Dim Murshed: Murshed = Inv.Cells(10, "D") 'F Ro_D = D.Cells(Rows.Count, 2).End(3).Row + 1 m = 13 Do Until Inv.Range("I" & m) = vbNullString Set where_Inv = Inv.Range("B" & m).Resize(, 5).Find("Ok") If Not where_Inv Is Nothing Then col = where_Inv.Column Set where_D = D.Range("B3:K3").Find(Inv.Cells(11, col), lookat:=1) If Not where_D Is Nothing Then D.Range("B" & Ro_D) = Rehla D.Range("C" & Ro_D) = Dt D.Range("D" & Ro_D) = ReH_Size D.Range("E" & Ro_D) = Hafila D.Range("F" & Ro_D) = Murshed D.Cells(Ro_D, where_D.Column) = where_Inv D.Cells(Ro_D, "k") = Inv.Range("G" & m) D.Cells(Ro_D, "L") = Inv.Range("J" & m) Ro_D = D.Cells(Rows.Count, 2).End(3).Row + 1 End If End If m = m + 1 Loop D.Range("B3").CurrentRegion.RemoveDuplicates _ Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11), Header:=1 Ro_D = D.Cells(Rows.Count, 2).End(3).Row With D.Range("B4").Resize(Ro_D - 3, 11) .Borders.LineStyle = 1 .Font.Size = 14: .Font.Bold = True .Interior.ColorIndex = 19 End With End Sub الملف مرفق Ritage_New.xlsm

يمكنك استخدام هذه المعادلة =IFERROR(LOOKUP(1,0/(tarheel!$C$2:$C$200=$C$1)/(tarheel!$B$2:$B$200=E$2),tarheel!$A$2:$A$200),"") ترحيل3.xlsm

وعليكم السلام اخى الفاضل @rey360 شوف التعديل وافتح النموذج ثم التقرير او افتح التقرير واكتب كود code client رقم 2 مثلا لامين ووافنا بالنتيجه بالتوفيق Base de données1352 - Copie - Copie(1).accdb

السلام عليكم ورحمة الله وبركاته الاصدار الرابع : فورم اضافة وبحث وتعديل مرن مع استعراض الصور (تحكم كامل بالصورة ) المرفق 2003 فورم ادخال و تعديل مرن مع الصور.rar http://www.officena.net/team/khboor/kh_image/p86.png هام جدا بتاريخ ( 14 / 6 / 2023 ) لكي يعمل الفورم جيدا بدون اخطاء لابد من عمل الاتي 1- UnRegister MSCOMCT2.OCX ازاله تسجيل الملف MSCOMCT2.OCX تشغيل الامر cmd كمسئول ثم كتابه الأمر التالي لو كان الويندوز ٦٤ بت regsvr32 /u C:\Windows\SysWOW64\MSCOMCT2.OCX او regsvr32 /u C:\Windows\System32\MSCOMCT2.OCX لو كان الويندوز ٣٢ ثم بفك الضغط عن الملف المرفق بأسم MSCOMCT2.OCX ونقوم بنسخه الي المسار التالي ويندوز٦٤ بت C:\Windows\SysWOW64 ويندوز ٣٢ بت C:\Windows\System32 2- Register MSCOMCT2.OCX ثم نقوم بعمل ريجستر للملف الذي نسخناه في الويندوز عن طريق هذا الأمر ويندوز ٦٤ regsvr32 C:\Windows\SysWOW64\MSCOMCT2.OCX ويندوز ٣٢ regsvr32 C:\Windows\Sys\MSCOMCT2.OCX MSCOMCT2.zip

الميزة التي انتظرها الكثير من الطلاب والمعلمين والقراء عموما أصبحت الآن بدون برامج إضافية ضمن تحديثات ويندوز 10 الأخيرة windows 10 build 1803 32bit or 64bit تحويل النص المكتوب إلى صوت مسموع Text to sppech والأجمل أنها باللغة العربية ومعنى هذا أنك بدلا من أن تقرا الملف تسمعه ولا ينقصني سوى دعاؤكم بالخير #ostazmas

بسم الله الرحمن الرحيم الحمد لله رب العالمين والصلاة والسلام على سيد الخلق محمد ﷺ اما بعد,, فهذا الاصدار الاول من برنامج شئون الطلاب الالكتروني يقوم البرنامج بعمل الآتي: تحميل بيانات الطلاب تلقائيا من موقع وزارة التربية والتعليم *صفحة بيانات تلميذ* تخزين البيانات والتعديل عليها بصورة سهلة جدا داخل البرنامج إنشاء سجل القيد المدرسي بأكثر من شكل وحجم A4 و A3 إنشاء قوائم الفصول إنشاء دفاتر المواظبة 5سلوك *يقوم البرنامج بوضع اسماء الايام لكل شهر تلقائيا* انشاء دفاتر الغياب انشاء سجل المصروفات انشاء كشف 12 للصف السادس الابتدائي كل هذا يتم تلقائيا بدون ادخال بيانات الطلاب بواسطة المستخدم اليكم بعض الصور من البرنامج ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ تم تحديث شرح البرنامج على اليوتيوب هــــــــــنا

وعليك السلام ليس هناك مشكلة اصلاً ... فربما يرجع هذا الى نظام الكمبيوتر لديك بالمنزل انك غير مبين امتدادات الملفات او مخفية فعليك بإظهارها كما بالصورة وليس هناك اى حل لطلبك سوى هذا وان لم يتغير شيء معك فلابد من تسطيب وينوز جديد لأن بهذا المشكلة فى الويندوز لديك

هذه الكلمه وغيرها من الكلمات يجب على المبرمج ان ينساها تماما ........... جرب المرفق ...... مثال.accdb

جرب هذه الكود تحت نفس زر التصدير بعد مسح الكود القديم الصق هذا الكود On Error Resume Next CurrentDb.Execute ("Delete * From temp") DoCmd.SetWarnings False DoCmd.RunSQL " SELECT qryElemnts1.stname INTO temp " & _ " FROM qryElemnts1;" DoCmd.SetWarnings True Dim TheFile As String Dim BackFile As String Dim lngColumn As Long Dim xlx As Object, xlw As Object, xls As Object, xlc As Object Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim blnEXCEL As Boolean, blnHeaderRow As Boolean blnEXCEL = False blnHeaderRow = False On Error Resume Next Set xlx = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set xlx = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 xlx.Visible = True TheFile = CurrentProject.Path & "\ms.xlsx" BackFile = CurrentProject.Path & "\äÓÎÉ ÇÍÊíÇØíÉ ãä ms.xlk" Set xlw = xlx.Workbooks.Open(TheFile) Set xls = xlw.Worksheets("students") 'ÇÓã æÑÞÉ ÇáÚãá Set xlc = xls.Range("B6") 'Çæá ÎáíÉ Ýí ãáÝ ÇáÇßÓá ÊÈÏà ÇáÊÚÈÆÉ ãäåÇ Set dbs = CurrentDb() Set rst = dbs.OpenRecordset("temp", dbOpenDynaset) 'ÇÓã ÇáÇÓÊÚáÇã If rst.EOF = False And rst.BOF = False Then rst.MoveFirst If blnHeaderRow = True Then For lngColumn = 0 To rst.Fields.Count - 1 xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name Next lngColumn Set xlc = xlc.Offset(1, 0) End If Do While rst.EOF = False For lngColumn = 0 To rst.Fields.Count - 1 rst.Edit 'rst!datasheat = rst!stname & HyperlinkPart(rst.Fields("datasheat"), acAddress) rst.Update xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value Next lngColumn rst.MoveNext Set xlc = xlc.Offset(1, 0) Loop End If rst.Close Set rst = Nothing dbs.Close Set dbs = Nothing Set xlc = Nothing Set xls = Nothing xlw.Close True Set xlw = Nothing If blnEXCEL = True Then xlx.Quit Set xlx = Nothing Kill (BackFile)

للاسف ما فهمت قصدك من الاول والحمد لله الاستاذ ازهر فهم ما تريد واكمل معك بالتوفيق

اعتقد المشكلة في نوع الاستعلام لانه يعتمد على التصفية في النموذج ..... الحل المؤقت : هو انشاء جدول مؤقت Temp من الاستعلام qryElemnts ثم تربط ما تريد به مباشرة ويتم حذفة بعد تصدير البيانات مباشرة

Base_de_données1352_-_Copie_-_Copie(1).accdb

وعليكم السلام ورحمة الله وبركاتة جرب هذا التعديل ان شاء الله يظبط معاك Private Sub CommandButton1_Click() Dim ws As Worksheet Set ws = ActiveWorkbook.Sheets("invoice") Dim wss As Worksheet Set wss = ActiveWorkbook.Sheets("Sheet1") Dim DT Dim Nam Dim lr As Long 'Application.ScreenUpdating = False 'Application.EnableEvents = False lr = wss.Range("a" & Rows.Count).End(xlUp).Row + 1 DT = ws.Range("e5") & Format(Now(), " ss - nn - hh - yyyy - mm - dd ") With ws Application.DisplayAlerts = False Nam1 = .Range("e5") Nam2 = Format(Now(), " ss - nn - hh - yyyy - mm - dd ") Nam = Nam1 & " " & Nam2 ThisWorkbook.SaveCopyAs Filename:="d:backBackup" & Nam & ".xlsm" ' '========================================= End With If ws.Range("F5").Value = "äÞÏí" Then Else: wss.Range("a" & lr).Value = Nam1 wss.Range("b" & lr).Value = Nam2 wss.Range("c" & lr).Value = "ÇÌá" End If If ws.[f5].Text = "ÇÌá" Then Else: wss.Range("a" & lr).Value = Nam1 wss.Range("b" & lr).Value = Nam2 wss.Range("c" & lr).Value = "äÞÏí" End If '======================================== ' äÓÎÉ ÇÍØíÇØíÉ ' '======================================== ' ActiveWorkbook.Close False End Sub

وعليكم السلام ,,,, تفضل محاولة مني Base_de_données1352_-_Copie_-_Copie(1).accdb

بارك الله فيك استاذ اجمد ربنا يحفظك اللهم امين

وعليكم السلام تفضل اخي جرب ووافينا بالنتيجة Shell "C:\Program Files\WinRAR\WinRAR.exe a -hp1 D:\bb\abolllll69.rar D:\bb\aboosama.accdb",vbHide

هو نفس الملف لكن انا أخفيت الأوراق الزائدة (ولم أحذفها) لسهولة تتبع الماكرو يمكنك اعادة اظهارها

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم تم تعديل اسم مربع تحرير وسرد الى Combobox1 وتم تعديل النموذج الفرعي الى subform1 ثم استخدمنا الكود التالي Private Sub Combobox1_Click() If Me.Combobox1.Value = "نعم" Then Me.subform1.Form.AllowEdits = True Me.subform1.Form.AllowAdditions = True Else If Me.Combobox1.Value = "لا" Then Me.subform1.Form.AllowEdits = False Me.subform1.Form.AllowAdditions = False End If End If End Sub Private Sub Form_Current() Combobox1_Click End Sub Database3_3.rar تحياتي

وجدت الحل وبارك الله فيكم، بعد عدة تجارب، شكرا تواريخ.xlsx

أخى الكريم ليست هناك اى مشكلة بالمعادلة ... فاذا قمت بطرح التاريخين المقصودين , ستحصل على النتيجة والمقدرة 364 يوم وجرب بنفسك فهذه بالفعل ليست سنة أبسطهالك يا استاذى .... فلديك فى هذان التاريخين 6 أشهر بقيمة 31 يوم للشهر = 6*31 يصبح الناتج 186 يوماً 5 أشهر بقيمة 30 يوم للشهر =5*30 يصبح الناتج 150 يوماً وشهر فبراير 28 يوم لسنة 2021 =1*28 يصبح الناتج 28 يوماً اذن إجمالى المدة كلها كما وضحت لك سلفاً هو 186+150+28 يصبح الناتج 364 يوماً وليس سنة كاملة والإكسيل فى هذه الحالة صحيح وفى غاية الدقة ... فطبيعة حسابات الفروق بين تاريخين فإما ان تضيف تاريخ البداية واما ان تضيف تاريخ النهاية فحسابيا لا يمكن حساب واضافة اليومين معاً .... وطبعاً لو محتاج ان يكون الناتج شهر كاملاً فلابد من اضافة +1 بالمعادلة وهذا بالطبع منطقياً وحسابيا خطأ بارك الله فيك

تم مغالجة الأمر و زيادة حبتين بجيث يمكنك الاتنقال الى اي شيت من خلال الضغط عل اسمها من الخلايا الصفراء صغحة (Salim) والعودة من اي شيت الى الرئيسية من حلال الضغط على الخلية Go to Salim ( لكن في المرة القادمة عليك بتوضيح كل شيء لعدم اهدار الوقت) Option Explicit '+++++++++++++++++++++++++++++++++++++++++ Sub ADD_SH_with_HyperLink() 'code to add Sheets One Time WITH HYPERLINKS 'Crated By Salim Hasbaya On 1/10/2020 ' Dim Rg As Range Dim sh As Worksheet Dim LB%, i%, x%, t% Dim Ws As Worksheet Set sh = Sheets("Salim") Application.ScreenUpdating = False Application.DisplayAlerts = False For Each Ws In Sheets If Ws.Name <> "Salim" Then Ws.Delete End If Next Application.DisplayAlerts = True LB = sh.Cells(Rows.Count, 2).End(3).Row For x = 2 To LB If sh.Range("b" & x) <> "" Then t = sh.Range("b" & x).MergeArea.Rows.Count If Not Application.Evaluate("ISREF('" & sh.Range("b" & x) & "'!A1)") Then Sheets.Add after:=Sheets(Sheets.Count) With ActiveSheet .Name = sh.Range("B" & x) sh.Range("A1:D1").Copy .Range("A1").PasteSpecial (11) .Range("A1").PasteSpecial (8) .Hyperlinks.Add Anchor:=.Range("F1"), _ Address:="", SubAddress:= _ "Salim!A1", TextToDisplay:="Goto SALIM" With .Range("A1").CurrentRegion .ColumnWidth = 19 .Borders.LineStyle = 1 .Font.Bold = True .Font.Size = 16 .Rows(2).InsertIndent 1 .Cells(2, 1).Select End With With .Range("F1") With .Font .Bold = True: .Size = 20 .ColorIndex = vbBlack .Italic = True End With .Interior.ColorIndex = 6 .Borders.LineStyle = 1 .Columns.AutoFit End With End With End If 'sh,exist End If '.value<>"" x = x + t - 1 Next x sh.Select add_data add_Hyper Application.CutCopyMode = False Application.ScreenUpdating = True End Sub '++++++++++++++++++++++++++++++++++ Sub add_data() Dim sh As Worksheet Dim LB%, i%, x%, t% Dim Ws As Worksheet Dim spec_sh As Worksheet Dim LS%, Ro% Set sh = Sheets("Salim") LS = sh.Cells(Rows.Count, 1).End(3).Row For i = 2 To LS t = sh.Cells(i, 2).MergeArea.Rows.Count Set spec_sh = Sheets(sh.Cells(i, 2) & "") Ro = spec_sh.Cells(Rows.Count, 1).End(3).Row + 1 sh.Cells(i, 1).Resize(t, 4).Copy _ spec_sh.Range("A" & Ro) i = i + t - 1 Next i End Sub '+++++++++++++++++++++++ Sub add_Hyper() Dim Ws As Worksheet Dim K% Set Ws = Sheets("Salim") Ws.Range("F2:F" & Sheets.Count).Clear For K = 2 To Sheets.Count Ws.Range("F" & K) = Sheets(K).Name Ws.Range("F" & K).Hyperlinks.Add _ Anchor:=Ws.Range("F" & K), _ Address:="", _ SubAddress:="'" & Sheets(K).Name & "'!A1", _ TextToDisplay:="Go TO " & Sheets(K).Name Next With Ws.Range("F2").Resize(K - 2) .Interior.ColorIndex = 6 .Borders.LineStyle = 1 .InsertIndent 1 .Font.Size = 14: .Font.Bold = True End With End Sub الملف مرفق Adb_Explicit.xlsm

هناك مسافة زائدة في اسم الصفحة "يناير "يجب ازالتها قم باضافة شيت تحت اي اسم مثلاً "Summation" بدون كود هذه المعادلة =SUM('يناير:مارس'!D4) أو هذا الكود Option Explicit Sub test() Dim First As Worksheet Dim Last As Worksheet Set First = Sheets("يناير") Set Last = Sheets("مارس") With Sheets("Summation").Range("D4") .Formula = "=SUM('" & First.Name & ":" & Last.Name & "'!D4)" .Value = .Value End With End Sub النلف مرفق Hissam.xlsm

تفضل يمكنك استخدام هذه المعادلة =SUMPRODUCT(SUMIF(INDIRECT("'"&sheets&"'!"&"b2:b100"),A2,INDIRECT("'"&sheets&"'!"&"d2:d100"))) تجريبى1.xlsx

تم التعديل على الملف hassan rady_1.xlsb

جرب هذا الماكرو Option Explicit Sub Salim() Dim RoA%, RoB%, i%, a%, b% Dim Rg_B As Range, Rg_A As Range Dim x As Boolean, y As Boolean, z As Boolean Dim Dc As Object RoA = Cells(Rows.Count, 1).End(3).Row RoB = Cells(Rows.Count, 2).End(3).Row Set Rg_B = Range("B2:B" & RoB) Set Rg_A = Range("A2:A" & RoA) Set Dc = CreateObject("Scripting.Dictionary") Range("D2").CurrentRegion.ClearContents i = 2 Do Until i = RoA + 1 If Cells(i, 1) = "" Then GoTo Next_i a = Application.CountIf(Rg_A, Cells(i, 1)) x = a > 1 b = Application.CountIf(Rg_B, Cells(i, 1)) y = b > 0 z = b < a And x And y If z Then Dc(Cells(i, 1).Value) = "" End If Next_i: i = i + 1 Loop If Dc.Count Then Range("D2").Resize(Dc.Count) = _ Application.Transpose(Dc.keys) End If End Sub الملف مرفق Mouhsen.xlsm

السلام عليكم من السهل استبدال تنسيق الاقواس نفسها بعد ذلك و هناك ايضا فكرة اعجبتني عن استبدال الاقواس بحرف مميز تجدها هنا و الحل الاخر هو اللجوء للكود و لكن ربما الامر لا يحتاج مثلا هذا الكود سيجعل كل ما بين الاقواس Bold ، و من دون الاقواس نفسها Sub FormatBetBrackets() Dim cDoc As Word.Document Dim cRng As Word.Range Set cDoc = ActiveDocument Set cRng = cDoc.Content cRng.Find.ClearFormatting With cRng.Find .Forward = True .Text = "(" .Wrap = wdFindStop .Execute Do While .Found cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd cRng.MoveEndUntil Cset:=")", Count:=Word.wdForward cRng.FormattedText.Bold = True cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd .Execute Loop End With End Sub و مثلما جعلنا الخط Bold يمكن التحكم بباقي الخصائص مثلا نجعله ازرق و حجم الخط 12 هكذا cRng.FormattedText.Bold = True cRng.FormattedText.Font.ColorIndex = wdBlue cRng.FormattedText.Font.Size = 12

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله هذا الموضوع من فترة كنت أبحث فيه وأتذكر أن هناك من طلب مثل هذا الطلب ، كما أنه يوجد موضوع بالمنتدى في الأيام الأخيرة لا أتذكره يخص إغلاق التطبيق وكيفية منع الإغلاق عن طريق زر الإغلاق الخاص بالتطبيق ، ووجدت زخم من الأكواد ، ومتاهات إلخ ... فقررت عمل موضوع لإنهاء الأمر والقضاء عليه بهدوء .. بأكواد بسيطة جداً بعيداً عن الزخم الغير مرغوب فيه والتعقيد الذي لا أحبذه في كثير من الأحيان ففي البساطة لو تعمقت في المسألة ، ستجد دائماً الحلول اليسيرة التي قد لا تخطر على بال الكثيرين سيكون محور العملية في كودين أحدهما يوضع في موديول .. ويكون بالشكل التالي Public CloseMode As Boolean Sub CloseMe() CloseMode = True ThisWorkbook.Save Application.Quit End Sub السطر الأول دا إعلان (بس مش في التليفزيون ولا إعلان على مواقع الانترنت ) دا إعلان في مشروع المصنف VBA Project ولا يخص الموديول فقط ، بل هو إعلان عاااااااااااااااااااااااااام أي أنه يمكن التعامل معه في أي موديول (سواء موديول عادي أو موديول ورقة عمل أو موديول المصنف أو موديول الفورم) المتغير اللي بيتم الإعلان عنه اسمه CloseMode ونوعه (يا إما ذكر يا إما أنثى) ..( True أو False) الإجراء المسمى CloseMe (والترجمة اقفلني .. والكلام ليس لي .. لأنك لو قفلتني مش هنزل الموضوع ده >> إنما المتحدث هنا هو الإكسيل .. فالإكسيل بيقولك اقفلني شكراً .. بس متقفلنيش من زر الإغلاق ..ابعد عن زر الإغلاق وغني له) أول سطر في الإجراء بيخلي المتغير العام قيمته True وتاني سطر بيحفظ المصنف والتالت بخرج من التطبيق وبس خلاص دي قفلة الكود End Sub تقريبا دي اختصار هند صبري (إند صب) دا الجزء الأول .. انتهينا منه *************************** شوية نجوم عشان الناس تصحصح تاني وتركز في الجزء التاني (كأننا في مسلسل مهند ونور) Private Sub Workbook_BeforeClose(Cancel As Boolean) If Not CloseMode Then Cancel = True MsgBox "Please Use The button To Close This File" End If End Sub الجزء ده بيوضع في حدث المصنف .. وكما ذكر أخونا إبراهيم أبو ليلة في سلسلة شروحاته إن الحدث دا بيتنفذ قبل الإغلاق .. يعني ببساطة لما أدوس للإكسيل على طرف (اللي هو زر الإغلاق) يتنفذ الأسطر الموجودة الأسطر عبارة عن جملة شرطية بتقول ايه : (نركز ونصحى عشان أنا هنام منكم أهو) لو المتغير العام CloseMode منفي .. يعني قيمته Fasle وممكن نكتب الشرط بالشكل ده If CloseMode = False Then واحد هيسأل طيب لو كانت قيمة المتغير True مش كدا ممكن نستخدم زر الإغلاق ؟؟؟ أقوله صحيح .. بس المتغير العام القيمة الافتراضية له False .. أول ما نفتح المصنف أي متغير بتكون قيمته الافتراضية 0 مثلاً لو كان متغير من النوع Long ، أو فراغ "" لو كان المتغير String ، أما القيمة الافتراضية للمتغير Boolean يا ناس يا حلوين هي القيمة False المهم نرجع للشرط .. فلو كانت قيمة المتغير CloseMode تساوي False ينفذ اللي جاي .. يا إما أروح أمشي أنا يا شيخ عبد الستار وطبعاً زي ما قلت القيمة الافتراضية False بالتالي بالتالي وأكيد هينفذ باقي الكود باقي الكود .. السطر Cancel = True معناها الغي عمل زر الإغلاق ، ومش بس كدا .. أنا مش هسيبك تضرب أخماس في أسداس وتقول نسخة الأوفيس خربت عندي .. لا أنا هظهر لك رسالة عشان تتأكد إن النسخة مخربتش الرسالة بتقول : روح يا ولدي استخدم الزر اللي ياسر خليل عمله في ورقة العمل ، عشان زر الإغلاق بتاع التطبيق ، سعادته ياسر بيه لعب في أساسه وعطله (أصلي من النوع المعطلاتي) وطبعاً زي ما اتعودنا من الأخ شعبولة إننا نقفل ، فالشرط اللي بدأناه كمان لازم يقفل بـ End IF .. زي بس خلاص بتاعة شعبولة ** نقطة أخيرة : واحد سامعه بيفكر (على فكرة هو متكلمش هو لسه بيفكر ..) دلوقتي لو عايز أقفل من زر الإغلاق مع وجود الكودين دووول أعمل ايه ؟؟ الإجابة : بسيطة جداً روح واعمل إجراء فرعي وخلي قيمة المتغير العام CloseMode تساوي True ( وبكدا تقدر تستخدم زر الإغلاق مرة أخرى) Sub EnableCloseButton() CloseMode = True End Sub ونفذ الإجراء الفرعي ده .. ضع مؤشر الماوس داخل الإجراء الفرعي وانقر Run أي تنفيذ الإجراء الفرعي ، أو F5 من لوحة المفاتيح ... تقدر دلوقتي تقفل من زر الإغلاق عادي لأنك جعلت قيمة المتغير العام CloseMode تساوي True وأقفل أنا كمان موضوعي بالقفلة المعروفة بالنسبة لي .. دمتم على طاعة الله ، ولا تنسونا من صالح دعائكم حمل الملف من هنا

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

السلام عليكم قبل ما ننزل برنامج النهارده في ملاحظة آه هي تضحك شوية ... فلو شفتوا المشاركات في الموضوع من بره هتلاقي العداد بيدي الف مشاركة تقريبا !!! طيب ولو بصيتوا على مشاركة البرنامج اللي بيصلح قواعد البيانات يعني لفوق شوية من الرد ده ؟؟؟؟؟؟ حتلاقي مفاجأة ...... 2285 مرة اتحمل ...!!! ايه ده حتصدق مين فيهم ؟؟؟؟؟؟ مش مهم انشاء الله مليون واحد حملوا المهم يستفيدوا موضوع النهاردة صيدلية ..... علشان الصيادلة ما يزعلوش ( كاملة ومفتوحة المصدر ومفيش باس وورد ولا حاجة ) وبكرة حاديكم العجب العجاب ( مصحة كاملة وشغالة 100%) ومفتوحة المصدر ومن غير باسوردات ولا حاجة ) وفيها كل شئ ايواء ودكاترة ومرضى وتنسيقها حلو ايجنن ...... استنونا بكرة مرفق اليوم ( الصيدلية ) _________2002.rar