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

السلام عليكم و رحمة الله تعالى و بركاته أخوتي الكرام حياكم الله. من المعروف أنه حين نجعل النموذج في وضعية ملأ الشاشة يزداد حجم النموذج و تبقى العناصر بنفس حجمها السابق مما يجعل شكل النموذج غير لائق نوعا ما. و نستطيع أن نتجاوز هذه المشكلة باستعمال الطريقة التالي: نقوم بإنشاء وحدة نمطية جديدة و نلصق بها الكود التالي: Function salah(frm As Form) On Error Resume Next Dim x, y, x1, y1 As Integer Dim moyH, moyW As Double Dim obj As Control Dim str As String x = frm.InsideHeight 'ارتفاع النموذج قبل التكبير y = frm.InsideWidth ' عرض النموذج قبل التكبير DoCmd.Maximize x1 = frm.InsideHeight 'ارتفاع النموذج بعد التكبير y1 = frm.InsideWidth ' عرض النموذج بعد التكبير moyH = x1 / x 'معامل الإرتفاع moyW = y1 / y ' معامل العرض For Each obj In frm.Controls With obj .Left = .Left * moyW .Top = .Top * moyH .Width = .Width * moyW .Height = .Height * moyH .FontSize = .FontSize * moyH End With Next End Function و أيضا أضف هذا الكود في حدث عند التحميل للنموذج: salah Me و لا تنسى أن تغير خاصية النموذج منبثق إلى نعم هذه الطريقة سوف تقوم بتكبير النموذج إلى وضعية ملأ الشاشة و تقوم بتكبير عناصر النموذج لملاءمة الوضعية الجديدة لنموذج. و الله هو الموفق. تكبير العناصر مع ملأ الشاشة لنموذج.rar

السلام عليكم اخي الكريم طرق الحل كثيرة منها ضع المعادلة التالية بالخلية D2 ثم اسحبها لاسفل =IFERROR(INDEX($A$2:$A$20,MATCH(0,INDEX(COUNTIF($D$1:D1,$A$2:$A$20),0,0),0)),"") والمعادلة التالية بالخلية E2 ثم اسحبها لاسفل =IF($D2="","",COUNTIF($A$2:$A$20,$D2))

بعد اذن اخوتي الكرام بما ان المرفق mdb فتفضل ما يناسبه هذه العبارة الصقها في التنسيق الشرطي للتطبيق على الارقام الزوجية [num] MOD 2 = 0 وهذه للارقام الفردية [num] MOD 2 = 1 وهذا المرفق تم التطبيق على خلية واحدة Prog20.rar

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

قم بإضافة هذا السطر إلى الوحدة النمطية بعد العنوان مباشرة On Error Resume Next

بسم الله نبدأ عامنا الحالي بهذه الموسوعة 1200_Visual_Basic_macro_examples.rar عسى أن ينال إعجابكم

بسم الله الرحمن الرحيم مقدمه أولادنا الصغار فلذة الأكباد نهديهم هذه الخطوط الرائعه المنقطة جزا الله صانعها الفاضل / ابو سلمان العمر وغيره كل خير وغفر الله ذنوبهم .. آمين ومن يسرها لنا ومن يسرها للظهور في المنتدى الفاضل / محمدي عبد السميع كل خير وكذلك نهديهم هذه الخطوط الرائعه المفرغة لكي يتم ملأها هذه الخطوط وتلك أيضا تصلح للكبار لتحسين خطوطهم كيفية الاستفاده من هذه الخطوط اكتب جملا تربويه مثلا: أكرم الأب ولده بالخط المنقط ... في هذه الجمله نغرس في نفس الطفل ان الأب كريم مع ولده . وهكذا ... ... ثم بعد ذلك يعيد المتمرن بالقلم الرصاص على هذه الكتابات عدة مرات الى ان تتقن يده كتابة الجملة بنفس المنظر وكأنه يصورها بارك الله لكم _______________.rar

السلام عليكم ورحمة الله وبركاتة كلنا نعرف دالة الاكسيل المشهورة ( VLOOKUP ) التى تبحث فى العمود الاول فقط من جدول وتستخرج النتيجة من عمود اخر دالتنا اليوم واسمها ( VLOOKAnyCol ) هى مثل دالة الاكسيل المشهورة ( VLOOKUP ) تماما وتمتاز عنها بعدم اشتراط البحث فى العمود الاول فقط فهى تبحث فى اى عمود ولا يشترط ان يكون العمود الاول وتستخرج النتيجة من عمود اخر - ولا تشترط ترتيب جدول البيانات وهى طبعا عربية بأيدى عربية شرح وبناء دالة ( VLOOKAnyCol ) :: دالة VLOOKAnyCol لها اربع مدخلات او باراميترات هم على التوالى :: جدول_البيانات / قيمة_البحث / عمود_البحث / عمود_النتيجة المدخل الأول :: جدول_البيانات :: جدول المعلومات الذي يتم البحث فيه عن البيانات ( قيمة_البحث ) فى اى عمود منه استخدم أحد المراجع لأحد النطاقات أو أحد أسماء النطاقات، مثل MyRng المدخل الثانى :: قيمة_البحث :: القيمة التي سيتم البحث عنها في العمود الذى تحدده ب ( عمود_البحث ) من جدول_البيانات يمكن أن تكون قيمة_البحث قيمة أو مرجع أو سلسلة نصية المدخل الثالث :: عمود_البحث :: هو رقم عمود الجدول الذى سيتم البحث فيه عن قيمة_البحث من جدول_البيانات المدخل الرابع :: عمود_النتيجة :: هو رقم عمود الجدول الذى سيتم استخراج النتيجة منه المقابلة ل قيمة_البحث والى لقاء قريب بإذن الله فى سلسلة الدوال العربية بالمرفقات الشرح مع مثال : VLOOKAnyCol.rar المرفق التالى عبارة عن ملف قيديو يبين كيفية نقل كود الدالة الى ملقك لتعمل الدالة به Omar_1.rar

أخي الكريم المسألة بسيطة جداً فقط اتبع الخطوات ولا تهمل منها شيء 1-حمل الملفات المرفقة بالمقال والموضوعة بملف مضغوط وبعد فك الضغط ينتج لك الملفين التاليين Module1 و NewMacros 2-افتح وورد ومن قائمة أدوات اختر : ماكرو > محرر Visual Basic 3-من قائمة File اختر Import file ثم اختر الملفات التي قمت بتحميلها من المرفق 4-اغلق صفحة Visual Basic وارجع لصفحة وورد 5-من قائمة عرض اختر أشرطة أدوات > تخصيص ، ومن التبويب الأوامر وتحت قائمة فئات اختر وحدات ماكرو لتظهر فى القائمة المقابلة أمر Normal.NewMacros.تفقيط واضغط علية بالماوس مع السحب إلى شريط القوائم أو أي مجموعة من الأزرار 6-يمكنك تعديل الاسم والخواص بالضغط بالزر الأيمن على الأمر الجديد وذلك قبل غلق مربع حوار تخصيص 7-اكتب أي رقم مرغوب في وورد ثم حدده وهذه النقطة مهمة " التحديد" ثم اكبس الزر أز الأمر الذي أنتجته فيظهر التفقيط فوراً 8- لتغيير الليرة السورية والقرش افتح وورد ومن قائمة أدوات اختر : ماكرو > محرر Visual Basic ثم اتجه لمجموعة النورمال Normal > ومنها Modules ثم افتح المسمى New Macros فتجد نوع العملة قم بتغييرها من هنا نجاح العملية معك يعتبر نجاح لي ولك على السواء scorpion4ever المرفق Tafqeet.rar

الاخ الكريم الكود هيكون بهذاالشكل Sub TARHEEELL() Dim FS As Worksheet, TS As Worksheet Dim R, ER1, ER2 Set TS = Sheets("data") Set FS = ActiveSheet ER2 = TS.Range("A55555").End(xlUp).Row + 1 Application.ScreenUpdating = False Sheets("data").Unprotect Password:="aaa" If FS.Name <> "data" Then For ER1 = 3 To FS.Cells(Rows.Count, 1).End(xlUp).Row If FS.Cells(ER1, 1) <> "" And FS.Cells(ER1, 14) <> "مرحل" Then TS.Cells(ER2, 1).Resize(1, 13).Value = FS.Cells(ER1, 1).Resize(1, 13).Value FS.Cells(ER1, 14) = "مرحل" ER2 = ER2 + 1 End If Next ER1 End If Application.ScreenUpdating = True Sheets("data").protect Password:="aaa" End Sub

السلام عليكم اختم الموضوع بجمع 3 طرق كما سبق ، ولكن باختلافات بسيطة ، واعرض هنا كيفية عمل جدول مؤقت خارج قاعدة البيانات (طبعا الجدول سيكون في قاعدة بيانات خارجية مؤقتة) ، ثم كيف ربط هذا الجدول المؤقت ببرنامجنا الحالي - تم حذف الجدول المؤقت من البرنامج ، 1. تم إضافة وحدات نمطية 2 (طبعا يمكن الاستغناء عنهم ، وذلك بضمهم لكود النموذج) ، الوحدة النمطية الاولى فيها كود لمناداة بعض مجلدات الوندوز المهمة ، ومنها مجلد Temp ، والذي سنتعامل معه لجميع البرامج/الملفات المؤقته ، والوحدة النمطية الثانية لعمل قاعدة البيانات الخارجية المؤقته ، 2. تم تقسيم عدد الاسطر الى عدد الاسطر والاعمدة ، ليتناسب مع عمل صفحة الانترنت بلغة HTML ، 3. سيقوم بعمل التقرير بواسطة صفحة انترنت بلغة HTML ، 4. سوف يفتح المجلد Temp وسيكون مختار ملف الانترنت الذي تم عمله بالزر رقم 3 ، 5. عمل التقرير بطريقة الاستاذ رمهان ، ولكن باستخدام جدول خارجي مؤقت ، 6. عمل التقرير بطريقة الاستاذ صالح ، ولكن باستخدام جدول خارجي مؤقت ، وهذه الطريقة هي الطريقة المستخدمة غالبا لمعظم الجداول المؤقته ، 7. يفتح المجلد Temp وسيكون مختار قاعدة البيانات الخارجية المؤقتة ، والتي تم عملها بالزرين رقم 5 و 6 ، . التقرير ، ونلاحظ انه لا يوجد له مصدر للبيانات (حيث ان المصدر يعتمد على استخدامنا للزر 5 او 6 ) ، والتقرير كما عمله اخونا ابوخليل ، . هذا كود التقرير: - عند فتحة ، يأخذ مصدر البيانات من المتغير mySQL والذي هو عبارة عن استعلام بصيغة SQL ، والذي يؤخذ من الجدول المؤقت (وسنرى في النموذج هذا الكود) ، - وعند اغلاق التقرير ، نغلق الجدول المؤقت ، وبقية الاستعلامات المحلية التي عُملت على اساسه ، Private Sub Report_Open(Cancel As Integer) Me.RecordSource = mySQL DoCmd.Maximize End Sub Private Sub Report_Unload(Cancel As Integer) On Error GoTo err_Report_Unload Dim OtherDB As Object qrydef.Close CurrentDb.Close 'close the temp_DB sOther = GetWinTemp & "\temp_DB.mdb" Set OtherDB = GetObject(sOther) OtherDB.Application.Quit Exit Sub err_Report_Unload: If Err.Number = 424 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub . الوحدة النمطية لمناداة بعض مجلدات الوندوز المهمة ، ومنها مجلد Temp ، والذي سنتعامل معه لجميع البرامج/الملفات المؤقته ، 'Return Windows directory Function GetWinDir() Set FS = CreateObject("Scripting.FileSystemObject") GetWinDir = FS.GetSpecialFolder(WindowsFolder) Set FS = Nothing End Function 'Return Windows/System directory Function GetWinSys() Set FS = CreateObject("Scripting.FileSystemObject") GetWinSys = FS.GetSpecialFolder(1) Set FS = Nothing End Function 'Return Windows/temp directory Function GetWinTemp() Set FS = CreateObject("Scripting.FileSystemObject") GetWinTemp = FS.GetSpecialFolder(2) Set FS = Nothing End Function 'Return temp filename Function GetTempName() Set FS = CreateObject("Scripting.FileSystemObject") GetTempName = FS.GetTempName Set FS = Nothing End Function 'Return full path and temp filename Function GetTempFullPath() GetTempFullPath = GetWinTemp & "\" & GetTempName Set FS = Nothing End Function . والوحدة النمطية الثانية لعمل قاعدة البيانات الخارجية المؤقته ، وبها وضعنا المتغيرات ، والتي تكون متاحة لكل كائنات قاعدة البيانات ، من نماذج وتقارير ووو Public tbldf As dao.TableDef, qrydf As dao.QueryDef, fld As Field Public rst As dao.Recordset, rst_TQ As dao.Recordset Public sfrm As Form Public wrkAcc As Workspace Public dbsNew As Database Public mdb_Path_Name As String Public mySQL As String Function Make_DB(mdb_Path_Name) On Error GoTo err_Make_DB 'create an empty mdb in the same PC as the FE 'this will allow more than one user to use This DB Set wrkAcc = CreateWorkspace("AccessWorkspace", "admin", "", dbUseJet) ' Make sure there isn't already a file with the name of the new database. If Dir(mdb_Path_Name) <> "" Then Kill mdb_Path_Name ' Create the new database Set dbsNew = wrkAcc.CreateDatabase(mdb_Path_Name, dbLangGeneral) dbsNew.Close wrkAcc.Close Exit Function err_Make_DB: If Err.Number = 3270 Then 'this field does not have a caption for it, give it the field name ElseIf Err.Number = 3024 Or Err.Number = 91 Or Err.Number = 52 Or Err.Number = 53 Or Err.Number = 3055 Then 'mdb, and Table not found to Delete Resume Next ElseIf Err.Number = 3167 Then 'ignor, Records Deleted Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function . هذا كود عمل الزر رقم 3 ، وهو كما وضعته في المشاركة السابقة ، والفرق اني وضعت ملف HTML في مجلد وندوز Temp ، وعملت الملصقات منع: Private Sub cmd_ie_Click() ' 'make Reference to Microsoft Internet Controls 'c:\windows\sysytem32\ieFrame.dll ' Dim web As SHDocVw.InternetExplorerMedium Set web = New SHDocVw.InternetExplorerMedium Dim HTML_File As String 'url header webBody = "<html style='width: 100%; height: 100%;'>" & vbCrLf webBody = webBody & "<head><style>" & vbCrLf '1 here we can change the Font Type, and Font size webBody = webBody & "table {font-family: arial, sans-serif; font-size:15px;border-collapse: collapse; width: 100%;}" & vbCrLf '2 here we can change cell border size, border color, Text alignment 'with black border 'webBody = webBody & "td, th {border: 1px solid #dddddd; text-align: center; padding: 8px;}" & vbCrLf 'without black border webBody = webBody & "td, th {border: 1px solid #FFFFFF; text-align: center; padding: 8px;}" & vbCrLf webBody = webBody & "</style></head><body>" & vbCrLf webBody = webBody & "<table style='width: 100%; height: 100%;'>" & vbCrLf 'How many Rows For i = 1 To Me.Rows 'to create the Table Row webBody = webBody & "<tr>" 'How many columns For j = 1 To Me.columns 'make each cell webBody = webBody & "<th>" & Me.co1.Column(1) & "</th>" Next j 'close the Table Row webBody = webBody & "</tr>" & vbCrLf Next i 'close the HTML code webBody = webBody & "</table></body></html>" 'Debug.Print webBody 'save the HTML file to windows Temp folder HTML_File = GetWinTemp & "\524.webBody.html" Open HTML_File For Output As #1 Print #1, webBody Close #1 'make an IE web.Navigate HTML_File 'wait until the page if fully loaded Do While web.ReadyState <> READYSTATE_COMPLETE Loop web.Stop 'print preview web.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT web.Quit Set web = Nothing End Sub . وهذا كود الزر رقم 4 ، والذي يفتح المجلد Temp وسيكون مختار ملف الانترنت الذي تم عمله بالزر رقم 3 : Private Sub cmd_Temp_Folder_web_Click() HTML_File = GetWinTemp & "\524.webBody.html" 'check if the file exists If Dir(HTML_File, vbNormal) = "" Then MsgBox "الملف غير موجود" Exit Sub End If 'open windows explorer and select the temporary inter file Shell "explorer.exe /select," & HTML_File, vbNormalFocus End Sub . وهذا كود الزر رقم 5 ، طريقة عمل التقرير للاستاذ رمهان بالجدول الخارجي المؤقت Private Sub cmd_Temp_Serial_Click() On Error GoTo err_cmd_Temp_Serial_Click 'طريقة الاستاذ رمهان If Len(Me.co1 & "") = 0 Then MsgBox "رجاء اختيار اسم الملصق" Exit Sub End If '1 'make a temp mdb mdb_Path_Name = GetWinTemp & "\temp_DB.mdb" Call Make_DB(mdb_Path_Name) '2 'Create table tbl_temp with Seq field as Integer. Set dbsNew = OpenDatabase(mdb_Path_Name) dbsNew.Execute "CREATE TABLE tbl_temp " & "(Seq INTEGER);" 'OR we can make a copy of an existing table from currentDB to the new DB 'make a Table temp_DB using "Make Table" query in the DB temp_DB.mdb ' mySQL = "SELECT temp_DB.* INTO tbl_temp IN " & Chr(34) & mdb_Path_Name & Chr(34) ' mySQL = mySQL & " FROM tmp_tbl_Dates_Days" 'Debug.Print mySQL ' DoCmd.SetWarnings False ' DoCmd.RunSQL mySQL ' DoCmd.SetWarnings True '3 'add Records to the temp table Set rst = dbsNew.OpenRecordset("Select * From tbl_temp") 'add one extra Record to meet the criteria For i = 1 To Me.Rows * Me.columns + 1 rst.AddNew rst!Seq = i rst.Update Next i rst.Close: Set rst = Nothing dbsNew.Close '4 'make a temporary query in this DB, from tbl_temp mySQL = "Select * From tbl_temp IN '" & mdb_Path_Name & "'" 'delete the old querydef, if exists CurrentDb.QueryDefs.Delete ("qrydef") 'create a new querydef Set qrydef = CurrentDb.CreateQueryDef("qrydef", mySQL) CurrentDb.Close '5 'make the Report Record Source 'mySQL is declared as Global Variable mySQL = "SELECT tbl1.B_Nm, qrydef.Seq FROM tbl1, qrydef" '6 'now open the Report 'DoCmd.OpenReport "QpNew", acViewPreview, , "[B_Nm]='" & Me.co1.Column(1) & "' And Seq<=" & Me.Rows * Me.columns myCriteria = "B_Nm='" & Me.co1.Column(1) & "'" myCriteria = myCriteria & " And Seq<=" & Me.Rows * Me.columns DoCmd.OpenReport "QpNew", acViewPreview, , myCriteria Exit Sub err_cmd_Temp_Serial_Click: If Err.Number = 3265 Or Err.Number = 3167 Or Err.Number = 3078 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub . وكود عمل التقرير بطريقة الاستاذ صالح ، بالجدول الخارجي المؤقت Private Sub cmd_Temp_Records_Click() 'طريقة الاستاذ صالح حمادي If Len(Me.co1 & "") = 0 Then MsgBox "رجاء اختيار اسم الملصق" Exit Sub End If '1 'make a temp mdb mdb_Path_Name = GetWinTemp & "\temp_DB.mdb" Call Make_DB(mdb_Path_Name) '2 'Create table tbl_temp with B_Nm field as Text. Set dbsNew = OpenDatabase(mdb_Path_Name) dbsNew.Execute "CREATE TABLE tbl_temp " & "(B_Nm Text);" 'OR we can make a copy of an existing table from currentDB to the new DB 'make a Table temp_DB using "Make Table" query in the DB temp_DB.mdb ' mySQL = "SELECT temp_DB.* INTO tbl_temp IN " & Chr(34) & mdb_Path_Name & Chr(34) ' mySQL = mySQL & " FROM tmp_tbl_Dates_Days" 'Debug.Print mySQL ' DoCmd.SetWarnings False ' DoCmd.RunSQL mySQL ' DoCmd.SetWarnings True '3 'add Records to the temp table Set rst = dbsNew.OpenRecordset("Select * From tbl_temp") For i = 1 To Me.Rows * Me.columns rst.AddNew rst!B_Nm = Me.co1.Column(1) rst.Update Next i rst.Close: Set rst = Nothing dbsNew.Close '4 'make the Report Record Source 'mySQL is declared as Global Variable mySQL = "Select * From tbl_temp IN '" & mdb_Path_Name & "'" '5 'now open the Report DoCmd.OpenReport "QpNew", acViewPreview End Sub . واخيرا ، كود الزر رقم 7 ، والذي يفتح المجلد Temp وسيكون مختار قاعدة البيانات الخارجية المؤقتة ، والتي تم عملها بالزرين رقم 5 و 6 ، Private Sub cmd_Temp_Folder1_Click() mdb_Path_Name = GetWinTemp & "\temp_DB.mdb" 'check if the file exists If Dir(mdb_Path_Name, vbNormal) = "" Then MsgBox "الملف غير موجود" Exit Sub End If 'open windows explorer and select the temporary database Shell "explorer.exe /select," & mdb_Path_Name, vbNormalFocus End Sub . جعفر 524.3.rep2.mdb.zip

تفضل ولكن الاولى يكون الرابط بين الجدولين معرف رقمي منضبط مثل رقم الهوية او الرقم القومي وليس الاسماء المهم ان الفكرة امامك الآن 2التقدم 2015 النهائي.rar

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

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

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

السلام عليكم في خصائص التفصيل للنموذج الفرعي ستجد لون سطر الخلفية ولون البديل حدد الالوان التي تريدها ثم احفظ واغلاق النموذج.. وقم بمعاينته

اخى جرب هذه الطريقه افتح الملف ادخل الى محرر الاكواد ثم اضغط مرتين على ThisWorkbook سيفتح لك محرر الاكواد ضع هذ الكود فى محرر الاكود Private Sub Workbook_Open() Application.Calculation = xlAutomatic End Sub ثم قف بالماوس فى وسط الكود ثم اضغط F5 لتفعيل الكود ثم جرب عمل المعادله ستجدها تعمل ان شاء الله تقبل تحياتى

كل التقدير و الاحترام لاستاذنا الكبير الاستاذ / رجب و هذا ايضا كود آخر يؤدى المطلوب دفعة واحدة Sub Looping1() Dim Arr As Variant, i As Integer, Lp As String, Fl As Variant Lr = Sheet1.UsedRange.Rows.Count Arr = Sheet1.Range("A2:F" & Lr) For y = 1 To UBound(Arr, 2) For i = 1 To UBound(Arr, 1) If Arr(i, y) <> "" Then p = p + 1 Lp = Arr(i, y) Fl = Split(Lp, " ") Cells(p + 1, 10) = Fl End If Next Next End Sub

كما اتفضل استاذي ابو الخليل شوف الصورة

تم اضافة المرجع ماهي الرسالة في هذا السطر استاذي Call MsgBox("ãä ÝÖáß ÇáÈÑäÇãÌ ÛíÑ ãÊÕá ÈÞÇÚÏÉ ÇáÈíÇäÇÊ ÇáÑÆíÓíÉÇáãÓãì (ÇßÊÈ ÇÓã ÇáÞÇÚÏÉ ÇáÎáÝíÉ åäÇ ÜÜ ÞÇÚÏÉ ÇáÌÏÇæá)

شكرا استاذي العزيز الاساذ / بن علية حاجي علي مجهودك وجزاك الله خيرا وعلما هل من الممكن التعديل حتي يمكن اطباعة 3 ثلاث جوبات في الورقة مع اضافة عداد الطباعة

السلام عليكم اخي الكريم قم بادراج ملف مبسط مشروح فيه المطلوب وان شاءالله تجد المساعدة تقبل مروري وتحياتي

تفقد خصائص الاداة ، انقر بالزر الايمن على الحقل واعبث بالقيم ااموجودة مثلا غير الخط الى 128 ، وانظر الفرق فقد تصل الى حل مرضي او ارفق مثالك على صيغة mdb

يجب اعادة الارتباط بقاعدة الجداول مرة اخري بعد عمل كلمة المرور

السلام عليكم و رحمة الله تعالى و بركاته أستاذ جعفر بعد إذنك أريد أن أطرح حلا آخر أو طريقة أخرى إن صح التعبير. نقوم بكتابة الكود التالي في منشأ التعبير لمربع النص الغياب: =IIf([الغياب]>0;[الغياب]) و أيضا مربع التسمية نحوله إلى مربع نص و نكتب في الكود التالي: =IIf("الغياب]>0;"الغياب]) و نغير خاصيتهما قابل للتقلص إلى نعم و كذلك التفصيل أو detail لنتحصل على النتيجة التالية: التقرير.rar

نعم أستاذ جعفر كلما إختلفت أفكارنا كلما زادت معلوماتنا من بعضنا البعض

جرب هذا الماكرو Sub formula_to_Vba() Dim Lr As Integer Lr = Sheets("سجل مبيعات نقد").Cells(Rows.Count, 2).End(3).Row Sheets("سجل مبيعات نقد").Range("j5:j" & Lr).ClearContents Sheets("سجل مبيعات نقد").Range("j5").Formula = "=IF(AND(B5>=$M$5,B5<=$M$6),'سجل مبيعات نقد'!C5,"""")" Range("j5").AutoFill Destination:=Range("j5:j" & Lr) Range("j5:j" & Lr).Value = Range("j5:j" & Lr).Value End Sub

الله يحفظك .. اليس هذا السطر لايجاد عدد الصفوف الموجود بها بيانات في صفحه بطاقه فرديه ؟ تجيب العدد الاجمالي منين !

التسلسل في صفحة غير صفحه الطباعة اخي الكريم

جزاكم الله خير

لو تقصد إن رقم آخر صف مش هيكون الإجمالي ممكن تعتمد على أمر آخر وهو قيمة الخلية في آخر صف (أعتقد إن فيه تسلسل من 1 إلى 410 مثلاً) .. فلو كان رقم آخر صف 400 مثلاً : حاجة من الاتنين يا إما تزود 10 على رقم آخر صف عشان توصل لإجمالي الطلاب بالشكل دا For i = 1 To sh.Cells(Rows.Count, 2).End(xlUp).Row + 10 Step 2 يا إما تجيب قيمة الخلية في آخر صف بالشكل دا For i = 1 To sh.cells(sh.Cells(Rows.Count, 2).End(xlUp).Row,1).value Step 2 أو طريقة تالتة إنك تستخدم دالة Countif في محرر الأكواد عشان تعد عدد الطلاب .. كل السبل تؤدي إلى روما ..

Sub Test() Dim sh As Worksheet Dim i As Long Set sh = Sheets("بطاقة فردية") For i = 1 To sh.Cells(Rows.Count, 2).End(xlUp).Row _ Step 2 sh.Range("M3").Value = i ActiveWindow.SelectedSheets.PrintOut Copies:=1 Next i End Sub في الحاله دي مش هايعد عدد الطلاب الاجمالي ..لان الصفحه خاصه بطباعه البطاقتين .. واللا تفكيري راح لبعيد يا استاذ ياسر

أستاذي أبو خليل بالنسبة للهوامش و المسافات حلها سهل لأني وضعت متغييرن x و y من أجل التعديل في القيم و الحصول على المظهر المطلوب مع العلم أن: كل 1 سم يساوي 576 وحدة تويب و ذلك من أجل الحصول على مسافات أكثر دقة قمت بتصميم برنامج صغير يقوم بهذه الحسابات أستاذي جعفر .نعم هذه فكرة جيدة لكن تصميم الحقول يدويا يأخذ وقت كبيرا يكفي أن تقوم بضبط قيم المتغيرين x و y في الكود كما وضعت ذلك في المرفق ماذا لو كان العدد المطلوب صفحة واحدة فهذا يعني أنه صوف تظهر صفحة أخرى في التقرير بيضاء لأن طول التقرير أكبر من طول ورقة واحدة هذا و الله أعلم فالنقاش المثمر معكم جد ممتاز و يخلي الواحد يعصر دماغو من أجل توليد فكرة جديدة و بتعدد الآراء تتحسن النتيجة كما ينوه الأستاذ جعفر دائما تحويل وحدات القياس للكائنات.rar rep2.rar

تمام الله ينور عليك أخي الكريم ناصر أحسنت

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

Sub Test() Dim sh As Worksheet Dim i As Long Set sh = Sheets("بطاقة فردية") For i = 1 To sh.Cells(Rows.Count, 2).End(xlUp).Row _ Step 2 sh.Range("M3").Value = i ActiveWindow.SelectedSheets.PrintOut Copies:=1 Next i End Sub هل هيصبح الكود بهذا الشكل ؟

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

قم بالإشارة للصفحة المطلوبة قبل بداية السطر يعني مثلاً لو الصفحة هي صفحة "البطاقات الفردية" ودي أسندناها لمتغير باسم sh ..فنضع الـ sh قبل بداية السطر المطلوب جلب رقم آخر صفحة في الورقة المعنية sh.Cells(rows.count,1).end(xlup).row

جزاك الله خيرا كده هاتعد الصفوف في صفحه البطاقه واللا في اي صفحه ؟

مرحبا استاذنا هل سيحتوي الجدول على اكثر من سجل . بحيث ان كل صفحة لسجل واحد مكرر 65 مرة ؟ واذا كان سجل واحد يتم تغييره كل مرة : يمكن عمل جدول اخر به 65 سجل وهمي ووضعه كمصدر للتقرير وعلى شكل استعلام مع الجدول الرئيسي وبدون ربط للحصول على العدد الديكارتي وهو سيكون 65 وبكذا سيتكرر الملصق 65 بالتقرير هذه فكره مستعجلة .. تحياتي

السلام عليكم و رحمة الله تعالى و بركاته. أخي الأستاذ محمد أيمن بعد إذنك أريد المشاركة معكم في هذا الموضوع: يمكن أيضا تنفيذ البحث عن ملف داخل الجهاز بهذا الكود: If Dir("D:\1.txt") = "" Then MsgBox "عذرا ملف الحماية غير موجود", vbCritical Quit End If

جرب الكود التالي Sub TARHEEELL() Dim FS As Worksheet, TS As Worksheet Dim R, ER1, ER2 Set TS = Sheets("data") Set FS = ActiveSheet ER2 = TS.Range("A55555").End(xlUp).Row + 1 Application.ScreenUpdating = False If FS.Name <> "data" Then For ER1 = 3 To FS.Cells(Rows.Count, 1).End(xlUp).Row If FS.Cells(ER1, 1) <> "" And FS.Cells(ER1, 14) <> "مرحل" Then TS.Cells(ER2, 1).Resize(1, 13).Value = FS.Cells(ER1, 1).Resize(1, 13).Value FS.Cells(ER1, 14) = "مرحل" ER2 = ER2 + 1 End If Next ER1 End If Application.ScreenUpdating = True End Sub

هذا الفورم عندما تقوم بتكبيره في وضعية ملأ الشاشة يزداد حجم النموذج فقط بينما العناصر الموجودة بداخل النموذج تبقى صغيرة لاحظ شكله الآن بعد التعديل قم بتكبير و تصغير النموذج و لاحظ جيدا الفرق form.rar

ماشاء الله تبارك الله .. بدايه موفقه ان شاء الله وان شاء الله يكون اضافه قويه لكل المهتمين بادارة المشاريع فى الوطن العربى .. هل موجود فى مكتيه يا بشمهندس فى مصر او فى السعوديه بدل من شرائه من على أمازون. جزاكم الله خيرا

استاذي الكبير اخجلتمونا بتشريفكم وبتعليقكم وبارك الله فيكم فأنتم ممن تتلمذنا على اعمالهم اللهم اجعل لهم نصيبأ" من خيرك لا ينفذ وغفرانا من كل ذنب وانفعهم بما انعمت عليهم كما نفعونا

ما هي الطريقة لاظهار النتائج في الست بوكس

السلام عليكم و رحمة الله أخي حسب طلبك يجب ان يكون تنسيق الارقام في العمود الذي يحتوي ترقيم على انها نص و لعمل بأفضل طريقة : 1) قم بإضافة ' فاصلة علوية واحدة قبل الرقم لنفرض الخلية A1 ثم اكتب الرقم 1 2) قم بسحبها بالماوس بدون الضغط على Ctrl . 3)عند اضافة سطر جديد انت لست بحاجة الا لخطوة واحدة فقط أمسك الخلية التي تعلو السطر المضاف ثم اسحبها بالماوس . أتمنى ان تكون قد اتضحت الفكرة دمت في حفظ الله

السلام عليكم و رحمة الله وبركاته ‏‏الاحد‏، 16‏/12‏/1429هـ. الموافق ‏14‏/12‏/08م الموضوع الأصلي على الرابط http://www.officena.net/ib/index.php?s=&am...st&p=125095 الطريقة الأولى باستخدام المعادلات في الإكسل و تعتمد على تسمية النطاقات - ويتم جمع المتغيرارت في عمود مستقل ثم يتم الوصول اليها بموجب رقم الصف ويتم نقل البيانات المطلوبة و الموجودة في مقابلها بموجب رقم الصف شاهدو المرفق ______________________1.rar

السلام عليكم ورحمة الله وبركاته مرفق ملف بعد التغيير ان شاء الله يكون طلبك اخوك / خبور