أ / محمد صالح

على افتراض أن العمود الذي به القيم السالبة هو A يمكنك استعمال هذا الكود For n = 2 To Cells(Rows.Count, "A").End(xlUp).Row If Cells(n, "A").Value < 0 Then Rows(n).Delete n = n - 1 End If Next n MsgBox "Done by mr-mas.com" بالتوفيق

إذا لم تكن مفعل version history من تبويب file ثم info فلا مجال للرجوع لنسخة احتياطية من الملف بالتوفيق

بالنسبة لموضوع إضافة حقل المدرسة والفصل لملف الاكسل يمكنك استعمال هذا الكود قبل كود الاستيراد 'Tools ->References -> Microsoft Excel Object Library Dim xlapp As Excel.Application, xlBook As Excel.Workbook, xlSheet As Excel.Worksheet Dim ExcelPath As String, lastRow As Long, lastcolumn As Long ExcelPath = CurrentProject.Path & "\ExcelFileName.xlsx" Set xlapp = CreateObject("Excel.Application") Set xlBook = xlapp.Workbooks.Open(ExcelPath) Set xlSheet = xlBook.Worksheets(1) With xlSheet lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column .Cells(1, lastcolumn + 1) = "school field title" .Range(.Cells(2, lastcolumn + 1), .Cells(lastRow, lastcolumn + 1)) = "school field value" .Cells(1, lastcolumn + 2) = "class field title" .Range(.Cells(2, lastcolumn + 2), .Cells(lastRow, lastcolumn + 2)) = "class field value" End With xlBook.Close 1 Set xlSheet = Nothing Set xlBook = Nothing Set xlapp = Nothing مع مراعاة تفعيل مرجع اكسل من قائمة tools وتغيير اسم ملف الاكسل واسم عنوان حقل المدرسة وقيمة حقل المدرسة واسم عنوان حقل الفصل وقيمة حقل الفصل بالتوفيق

الكود فعلا يحدد نطاق البحث في بداية الاسم للوصول لما تريد غير هذا السطر في حدث عند تغيير مربع النص10 If C Like TextBox10.Value & "*" Then إلى If C Like "*" & TextBox10.Value & "*" Then بالتوفيق

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

نظرا لاستعمالك Option Explicit في بداية الكود يجب الإعلان عن المتغيرات ضع هذا السطر كأول سطر في إجراء البحث Dim ws As Worksheet, i As Long, i2 As Long بالتوفيق

يمكنك استعمال هذه الأكواد في النموذج Private Sub ComboBox1_Change() Sheet1.Range("a1").CurrentRegion.AutoFilter Field:=4, Criteria1:=ComboBox1.Value End Sub Private Sub ComboBox2_Change() Sheet1.Range("a1").CurrentRegion.AutoFilter Field:=5, Criteria1:=ComboBox2.Value End Sub Private Sub ComboBox3_Change() Sheet1.Range("a1").CurrentRegion.AutoFilter Field:=6, Criteria1:=ComboBox3.Value End Sub Private Sub CommandButton1_Click() ComboBox1.Value = "" ComboBox2.Value = "" ComboBox3.Value = "" Sheet1.Range("a1").CurrentRegion.AutoFilter End Sub Private Sub UserForm_Initialize() Me.ComboBox1.List = Array("معلم", "مهندس", "فني", "مدير", "مهندس اقدم", "محامي") For n = 1 To 12 Me.ComboBox2.AddItem n Next n For n = 2003 To 2022 Me.ComboBox3.AddItem n Next n End Sub لاحظ طرق تعبئة combobox واستعمال currentregion بالتوفيق

يمكنك استعمال هذه الأكواد كود تصدير الاستعلام إلى اكسل في نفس مجلد البرنامج DoCmd.OutputTo acOutputQuery, "QueryName", acFormatXLSX, CurrentProject.Path & "\ExcelFileName.xlsx", False مع مراعاة تغيير اسم الاستعلام queryname واسم ملف الاكسل excelfilename كود الاستيراد من اكسل إلى جدول DoCmd.TransferSpreadsheet acImport, 8, "TableName", CurrentProject.Path & "\ExcelFileName.xlsx", True مع مراعاة تغيير اسم الجدول وملف الاكسل ومراعاة تطابق أسماء الأعمدة (وليست التسمية caption) في الجدول مع خلايا الصف الأول في ملف الاكسل وطبعا عدم تكرار قيم حقل المفتاح الأساسي ومعرفة أن الأعمدة التي لم يتم استيرادها ستكون فارغة بالتوفيق

أشعر بشيء من عدم ترتيب الأفكار مادام الأمر به انتقاء لبعض الأعمدة لتصديرها وبعض الأعمدة لا تصدر فيجب إنشاء استعلام ثم تصدير هذا الاستعلام ماذا عن البيانات الموجودة في الجدول . هل يتم حذفها أم الإضافة عليها وتكرار السجلات وإذا تم حذفها ماذا عن الأعمدة التي لم يتم تصديرها. هل تظل فارغة بدون بيانات ؟ رجاء توضيح المطلوب بكل تفاصيله وأهدافه

نعم هناك طرق كثيرة واختيار أحدها من خلال رؤية ملفك واحتياجاته

إذا لم يفدك ردي السابق المختصر ربما يفيدك هذا الموضوع بالتوفيق

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

هل تعني أن شرط + و yes ينطبق أيضا على E13 & E14؟ إذا كان هذا هو المطلوب فيمكن تغيير Elseif إلى End If If تم تحديث الكود السابق

حتى يعمل أي كود على ويندوز 64بت نضع ptrsafe قبل function في الإعلان عن أي دالة من دالات النظام

يمكنك أن تجعل مصدر عنصر التحكم =DSum("[dr]","tablee","[fdate] Between [Forms]![xx]![big] AND [Forms]![xx]![end]") بالتوفيق

تفضل هذا ملفك بعد تعديل إجراء التسليم إلى ما يلي Sub Submit_Data() Dim iRow As Long, row As Long, sh As Worksheet If frmDataEntry.txtRowNumber.Value = "" Then Set sh = shDatabase iRow = sh.Range("A" & Rows.Count).End(xlUp).row + 1 Else If frmDataEntry.ComboBox7 = "Check OUT" Then Set sh = Sheet2 iRow = sh.Range("A" & Rows.Count).End(xlUp).row + 1 row = frmDataEntry.lstDatabase.List(frmDataEntry.lstDatabase.ListIndex, 0) + 1 ThisWorkbook.Sheets("Database").Rows(row).Delete Else Set sh = shDatabase iRow = frmDataEntry.txtRowNumber.Value End If End If With sh.Range("A" & iRow) .Offset(0, 0).Value = "=if(b" & iRow & "="""","""",Row()-1)" .Offset(0, 1).Value = frmDataEntry.TextBox1.Value .Offset(0, 2).Value = frmDataEntry.TextBox2.Value .Offset(0, 3).Value = frmDataEntry.TextBox3.Value .Offset(0, 4).Value = frmDataEntry.ComboBox1.Value .Offset(0, 5).Value = frmDataEntry.ComboBox2.Value .Offset(0, 6).Value = frmDataEntry.TextBox4.Value .Offset(0, 7).Value = frmDataEntry.TextBox5.Value .Offset(0, 8).Value = frmDataEntry.TextBox6.Value .Offset(0, 9).Value = frmDataEntry.TextBox7.Value .Offset(0, 10).Value = frmDataEntry.TextBox8.Value .Offset(0, 11).Value = frmDataEntry.ComboBox3.Value .Offset(0, 12).Value = frmDataEntry.ComboBox4.Value .Offset(0, 13).Value = frmDataEntry.ComboBox5.Value .Offset(0, 14).Value = frmDataEntry.ComboBox6.Value .Offset(0, 15).Value = frmDataEntry.TextBox9.Value .Offset(0, 16).Value = frmDataEntry.ComboBox7.Value End With If frmDataEntry.txtRowNumber.Value = "" Then MsgBox "Data Submitted Successfully!" Else MsgBox "Data updated Successfully!" End If Call Reset_Form Application.ScreenUpdating = True End Sub بالتوفيق program.xlsm

بالنسبة للمطلوب الأول تحتاج فقط لملاءمة الطباعة في صفحة واحدة فقط وأسهل طريق لها في نافذة معاينة قبل الطباعة أو من اعداد الصفحة وبالنسبة للأرقام فهي فعلا يتم جلبها لصفحة الطباعة تلقائيا بسبب وجود معادلات البحث وبالنسبة للتاريخ في صفحة الطباعة فهو مضبوط وإذا كنت تقصد في صفحة إدخال البيانات فاستعمل في خلية اليوم =TEXT(TODAY(),"b2dd") وفي خلية الشهر =TEXT(TODAY(),"b2mm") وفي خلية العام =TEXT(TODAY(),"b2yyyy") بالتوفيق

إن شاء الله يفيدك هذا الموضوع بالتوفيق

ما شاء اللّه رائع بارك الله لك

إن شاء اللّه يفيدك هذا الموضوع بالتوفيق

تفضل أخي الكريم هذا اللغز من أفضل الألغاز التي قابلتها حيث استمرت المحاولات فيه يومين والحمد لله تم إنجازه إن شاء الله هذا الكود يقوم باللازم Sub mas_generateMsg() Dim SumH(1000) As Variant, SumV(1000) As Variant For i = 17 To Sheet3.Cells(Rows.Count, 5).End(xlUp).Row msg = "": frst = True: fw = Sheet3.Cells(i, 8) msg = msg & "عند خروج الفاتوره رقم " & Sheet3.Cells(i, 5) & " بتاريخ " & Format(Sheet3.Cells(i, 6), "yyyy/mm/dd") For c = 17 To Sheet2.Cells(Rows.Count, 6).End(xlUp).Row lw = Sheet2.Cells(c, 9) lot = IIf(fw - SumH(i) > lw, lw, fw - SumH(i)) mylot = IIf(lw - SumV(c) > lot, lot, lw - SumV(c)) If mylot > 0 And frst Then frst = False: msg = msg & " تم استخدام خامات من اللوت رقم " & Sheet2.Cells(c, 6) & " بوزن " & mylot ElseIf mylot > 0 And Not frst Then msg = msg & " وأيضا من اللوت رقم " & Sheet2.Cells(c, 6) & " بوزن " & mylot End If SumV(c) = SumV(c) + mylot: SumH(i) = SumH(i) + mylot Next c Sheet4.Range("g" & i + 9) = msg Next i MsgBox "Done by mr-mas.com" End Sub نفعنا الله جميعا بما علمنا وعلمنا ما ينفعنا

يوجد في المنتدى الكثير من الشروح هذا جانب منها بالتوفيق

يمكنك استعمال هذا الكود في حدث عند التغيير Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 8 And Target.Row < 17 And Target.Column = 5 Then Dim C As Range, a As Boolean, b As Boolean For Each C In Range("E9:E16") If InStr(C.Value, "Positive") And (C.Row = 13 Or C.Row = 14) Then If Not a Then Range("C13").Value = "Titer250": a = True End If If InStr(C.Value, "+") Or InStr(C.Value, "yes") Then If Not b Then Range("C10").Value = "Positive": b = True End If Next C If Not a Then Range("C13").Value = "Nil" If Not b Then Range("C10").Value = "Negative" End If End Sub بالتوفيق

حسب فهمي للمطلوب تم وضع معادلة تحسب المتبقي على التاريخ (إذا كان بعد تاريخ اليوم) وتنسيق المدة ب data bar بالتوفيق تنسيق المتبقي على تاريخ.xlsx

يمكنك استعمال الدالة val لتحصل على القيمة Range("e" & lrow).Value = Val(TextBox1.Value) Range("f" & lrow).Value = Val(TextBox2.Value) Range("g" & lrow).Value = Val(TextBox3.Value) بالتوفيق