كل الانشطه

شكرا استاذ ربي يحفظك

استبدل الكود بهذا <><><><><><><> Private Sub أمر0_Click() On Error Resume Next OpenClsword (CurrentProject.Path & "\123.doc") Objwrd.ActiveDocument.Bookmarks("AA").Select Objwrd.Selection.InsertAfter txtYear Objwrd.ActiveDocument.Bookmarks("A1").Select Objwrd.Selection.InsertAfter Format(tx1, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A2").Select Objwrd.Selection.InsertAfter Format(tx2, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A3").Select Objwrd.Selection.InsertAfter Format(tx3, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A4").Select Objwrd.Selection.InsertAfter Format(tx4, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A5").Select Objwrd.Selection.InsertAfter Format(tx5, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A6").Select Objwrd.Selection.InsertAfter Format(tx6, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A7").Select Objwrd.Selection.InsertAfter Format(tx7, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A8").Select Objwrd.Selection.InsertAfter Format(tx8, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A9").Select Objwrd.Selection.InsertAfter Format(tx9, "#,##0.00") End Sub

عدل كما بالشرح اسم الحقل (PicPath2) بدلا من (Pic1) .

1. تصميم نموذج الإدخال (UserForm) قم بإنشاء UserForm جديد في محرر VBA (Alt + F11) وقم بتسمية العناصر كالتالي: ComboBox1: لنوع الحركة (إضافة، صرف، تحويل، شراء، بيع). ComboBox2: للمخزن (المصدر/الرئيسي). ComboBox3: للمخزن (الهدف - يظهر فقط في حالة التحويل). ComboBox4: للصنف. ComboBox5: للوحدة. ComboBox6: للحالة (جديد، مستعمل، تالف). TextBox1: للكمية. Listbox1 : عرض البيانات CommandButton1: زر "ترحيل CommandButton2: زر "حفظ Private Sub UserForm_Initialize() Dim wsSetup As Worksheet Set wsSetup = Sheets("Setup") Dim lastRow As Long ' 1. تعبئة أنواع الحركة يدوياً ComboBox1.List = Array("إضافة", "صرف", "تحويل", "شراء", "بيع") ' 2. تعبئة المخازن من شيت Setup (العمود A) lastRow = wsSetup.Cells(wsSetup.Rows.Count, 1).End(xlUp).Row ComboBox2.List = wsSetup.Range("A2:A" & lastRow).Value ' من مخزن ComboBox3.List = wsSetup.Range("A2:A" & lastRow).Value ' إلى مخزن ' 3. تعبئة الأصناف من شيت Setup (العمود B) lastRow = wsSetup.Cells(wsSetup.Rows.Count, 2).End(xlUp).Row ComboBox4.List = wsSetup.Range("B2:B" & lastRow).Value ' 4. تعبئة الوحدات والحالات بنفس الطريقة ComboBox5.List = Array("قطعة", "كيلو", "كرتونة") ComboBox6.List = Array("جديد", "مستعمل", "تالف") ' تحديث ListBox لعرض آخر الحركات UpdateListBox End Sub الحركة". Private Sub ComboBox1_Change() ' إذا كانت الحركة تحويل، أظهر خانة المخزن المحول إليه If ComboBox1.Value = "تحويل" Then ComboBox3.Visible = True Label_ToStore.Visible = True ' افترضنا أنك وضعت عنواناً بجانبه Else ComboBox3.Visible = False Label_ToStore.Visible = False ComboBox3.Value = "" ' مسح القيمة إذا لم تكن تحويلاً End If End Sub Sub UpdateListBox() Dim ws As Worksheet Set ws = Sheets("Transactions") Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' ضبط عدد الأعمدة في ListBox With ListBox1 .ColumnCount = 5 .ColumnWidths = "60;60;80;80;50" ' عرض آخر 5 صفوف فقط (إذا توفرت) If lastRow > 5 Then .List = ws.Range("A" & lastRow - 4 & ":E" & lastRow).Value ElseIf lastRow > 1 Then .List = ws.Range("A2:E" & lastRow).Value End If End With End Sub Private Sub BtnSearch_Click() Dim ws As Worksheet: Set ws = Sheets("Transactions") Dim rowNum As Long Dim searchText As String searchText = TxtSearch.Value ' خانة البحث عن رقم الإذن On Error Resume Next ' البحث عن رقم الإذن في العمود الثاني (رقم الإذن) rowNum = Application.Match(CLng(searchText), ws.Columns(2), 0) On Error GoTo 0 If rowNum > 0 Then ' تعبئة الخانات بالبيانات الموجودة في الشيت ComboBox1.Value = ws.Cells(rowNum, 2).Value ' نوع الحركة ComboBox2.Value = ws.Cells(rowNum, 3).Value ' من مخزن ' ... استكمل لبقية الخانات ... TextBox1.Value = ws.Cells(rowNum, 8).Value ' الكمية ' تخزين رقم الصف في Label مخفي للرجوع إليه عند التعديل LblRowNumber.Caption = rowNum MsgBox "تم جلب البيانات، يمكنك تعديلها الآن", vbInformation Else MsgBox "رقم الإذن غير موجود", vbExclamation End If End Sub Private Sub BtnUpdate_Click() Dim ws As Worksheet: Set ws = Sheets("Transactions") Dim rowNum As Long rowNum = Val(LblRowNumber.Caption) ' استرجاع رقم الصف المخزن If rowNum > 1 Then ws.Cells(rowNum, 2).Value = ComboBox1.Value ws.Cells(rowNum, 3).Value = ComboBox2.Value ws.Cells(rowNum, 5).Value = ComboBox4.Value ws.Cells(rowNum, 8).Value = CDbl(TextBox1.Value) MsgBox "تم تحديث البيانات بنجاح", vbInformation UpdateListBox ' تحديث القائمة لرؤية التعديل End If End Sub Function GetNextSerial() As Long Dim ws As Worksheet: Set ws = Sheets("Transactions") Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row If lastRow < 2 Then GetNextSerial = 1001 ' يبدأ الترقيم من هذا الرقم Else GetNextSerial = ws.Cells(lastRow, 2).Value + 1 End If End Function Function ConvertToBox(ItemName As String, TotalPieces As Double) As String Dim wsSetup As Worksheet: Set wsSetup = Sheets("Setup") Dim PackSize As Integer Dim Boxes As Integer, Remainder As Integer Dim cell As Range ' البحث عن سعة كرتونة الصنف في شيت Setup Set cell = wsSetup.Range("B:B").Find(ItemName, LookIn:=xlValues, LookAt:=xlWhole) If Not cell Is Nothing Then PackSize = cell.Offset(0, 1).Value ' السعة موجودة في العمود التالي If PackSize > 0 Then Boxes = Int(TotalPieces / PackSize) ' عدد الكراتين الكاملة Remainder = TotalPieces Mod PackSize ' القطع المتبقية ConvertToBox = Boxes & " كرتونة و " & Remainder & " قطعة" Else ConvertToBox = TotalPieces & " قطعة" End If Else ConvertToBox = TotalPieces & " قطعة" End If End Function Private Sub TxtQty_Change() On Error Resume Next If TxtQty.Value <> "" And ComboBox4.Value <> "" Then ' تحديث العنوان بالتحويل التلقائي LblPackingInfo.Caption = ConvertToBox(ComboBox4.Value, CDbl(TxtQty.Value)) Else LblPackingInfo.Caption = "" End If End Sub Sub RefreshInventoryReport() Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions") Dim wsInv As Worksheet: Set wsInv = Sheets("Inventory_Summary") Dim lastRow As Long, i As Long ' مسح البيانات القديمة wsInv.Range("A2:E1000").ClearContents ' استخدام Pivot Table خلفي أو مجموع شرطي لجلب الأرصدة ' هنا سنفترض أنك تريد جلب الأصناف الفريدة المتاحة ' كود مبسط لجلب الأرصدة: lastRow = wsTrans.Cells(wsTrans.Rows.Count, 5).End(xlUp).Row ' كود افتراضي لجمع الكميات (يفضل استخدام PivotTable لسرعة أكبر في البيانات الضخمة) ' ولكن هنا سنستخدم الدالة التي برمجناها سابقاً للتحويل ' مثال لتعبئة الصف الأول (كمثال توضيحي): Dim totalQty As Double: totalQty = 150 ' هذا الرقم يأتي من SUMIFS Dim itemName As String: itemName = "صنف A" wsInv.Range("A2").Value = itemName wsInv.Range("D2").Value = totalQty ' استخدام الدالة التي صممناها في الخطوة السابقة wsInv.Range("E2").Value = ConvertToBox(itemName, totalQty) End Sub Private Sub ComboBox4_Change() Dim ws As Worksheet: Set ws = Sheets("Transactions") Dim CurrentStock As Double Dim ItemName As String: ItemName = ComboBox4.Value Dim StoreName As String: StoreName = ComboBox2.Value ' المخزن المختار ' حساب الرصيد الحالي برمجياً باستخدام WorksheetFunction CurrentStock = Application.WorksheetFunction.SumIfs(ws.Range("I:I"), ws.Range("F:F"), ItemName, ws.Range("D:D"), StoreName) - _ Application.WorksheetFunction.SumIfs(ws.Range("I:I"), ws.Range("F:F"), ItemName, ws.Range("C:C"), StoreName) ' عرض النتيجة للمستخدم مع التحويل للكراتين LblCurrentBalance.Caption = "الرصيد المتاح في هذا المخزن: " & ConvertToBox(ItemName, CurrentStock) End Sub Private Sub BtnSave_Click() Dim ws As Worksheet: Set ws = Sheets("Transactions") Dim CurrentStock As Double Dim ItemName As String: ItemName = ComboBox4.Value Dim StoreName As String: StoreName = ComboBox2.Value Dim RequestedQty As Double: RequestedQty = CDbl(TxtQty.Value) ' فحص إذا كانت الحركة (صرف، بيع، أو تحويل صادر) If ComboBox1.Value = "صرف" Or ComboBox1.Value = "بيع" Or ComboBox1.Value = "تحويل" Then ' حساب الرصيد الحالي في هذا المخزن تحديداً CurrentStock = Application.WorksheetFunction.SumIfs(ws.Range("I:I"), ws.Range("F:F"), ItemName, ws.Range("D:D"), StoreName) - _ Application.WorksheetFunction.SumIfs(ws.Range("I:I"), ws.Range("F:F"), ItemName, ws.Range("C:C"), StoreName) ' المقارنة بين المتاح والمطلوب If RequestedQty > CurrentStock Then MsgBox "عذراً.. الرصيد غير كافٍ في " & StoreName & vbCrLf & _ "الرصيد المتاح هو: " & CurrentStock & " قطعة فقط.", vbCritical, "تنبيه أمان المخزن" Exit Sub ' إيقاف عملية الحفظ End If End If ' ... بقية كود الترحيل والحفظ الذي كتبناه سابقاً ... End Sub Private Sub TxtQty_Change() ' كود إضافي لتحسين تجربة المستخدم On Error Resume Next ' (بافتراض أنك حسبت CurrentStock مسبقاً) If CDbl(TxtQty.Value) > CurrentStock Then TxtQty.BackColor = vbRed TxtQty.ForeColor = vbWhite Else TxtQty.BackColor = vbWhite TxtQty.ForeColor = vbBlack End If End Sub Private Sub Workbook_Open() Dim wsSetup As Worksheet: Set wsSetup = Sheets("Setup") Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions") Dim lastRow As Long, i As Long Dim currentBal As Double, reorderLevel As Double Dim itemName As String, msg As String lastRow = wsSetup.Cells(wsSetup.Rows.Count, 1).End(xlUp).Row msg = "الأصناف التالية وصلت لحد الطلب أو أقل:" & vbCrLf For i = 2 To lastRow itemName = wsSetup.Cells(i, 2).Value reorderLevel = wsSetup.Cells(i, 4).Value ' حساب الرصيد الإجمالي للصنف في كل المخازن currentBal = Application.WorksheetFunction.SumIfs(wsTrans.Range("I:I"), wsTrans.Range("F:F"), itemName) - _ Application.WorksheetFunction.SumIfs(wsTrans.Range("I:I"), wsTrans.Range("F:F"), itemName) ' (تعديل بسيط حسب هيكلة مخازنك) If currentBal <= reorderLevel Then msg = msg & "- " & itemName & " (الرصيد الحالي: " & currentBal & ")" & vbCrLf End If Next i If msg <> "الأصناف التالية وصلت لحد الطلب أو أقل:" & vbCrLf Then MsgBox msg, vbExclamation, "تنبيه نقص المخزون" End If End Sub ' يوضع هذا الكود بعد ترحيل حركة الصرف مباشرة في زر الحفظ If (CurrentStock - RequestedQty) <= reorderLevel Then MsgBox "تنبيه: الصنف " & ItemName & " أصبح رصيده منخفضاً جداً!", vbInformation End If Private Sub BtnSave_Click() Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions") Dim wsSetup As Worksheet: Set wsSetup = Sheets("Setup") Dim nextRow As Long, CurrentStock As Double, ReorderLevel As Double ' --- 1. التحقق من الرصيد (أمان المخزن) --- If ComboBox1.Value = "صرف" Or ComboBox1.Value = "بيع" Or ComboBox1.Value = "تحويل" Then CurrentStock = Application.WorksheetFunction.SumIfs(wsTrans.Range("I:I"), wsTrans.Range("F:F"), ComboBox4.Value, wsTrans.Range("D:D"), ComboBox2.Value) - _ Application.WorksheetFunction.SumIfs(wsTrans.Range("I:I"), wsTrans.Range("F:F"), ComboBox4.Value, wsTrans.Range("C:C"), ComboBox2.Value) If CDbl(TxtQty.Value) > CurrentStock Then MsgBox "عذراً! الرصيد غير كافٍ. المتاح: " & CurrentStock, vbCritical: Exit Sub End If End If ' --- 2. ترحيل البيانات --- nextRow = wsTrans.Cells(wsTrans.Rows.Count, 1).End(xlUp).Row + 1 With wsTrans .Cells(nextRow, 1).Value = Date .Cells(nextRow, 2).Value = TxtSerial.Value .Cells(nextRow, 3).Value = ComboBox1.Value ' نوع الحركة .Cells(nextRow, 4).Value = ComboBox2.Value ' من مخزن .Cells(nextRow, 5).Value = ComboBox3.Value ' إلى مخزن .Cells(nextRow, 6).Value = ComboBox4.Value ' الصنف .Cells(nextRow, 8).Value = ComboBox6.Value ' الحالة .Cells(nextRow, 9).Value = CDbl(TxtQty.Value) End With ' --- 3. تنبيه حد الطلب بعد العملية --- ' (كود إضافي لفحص حد الطلب من شيت Setup) MsgBox "تمت العملية بنجاح!", vbInformation Unload Me: UserForm1.Show End Sub Private Sub Workbook_Open() ' هنا نضع الكود الذي يمسح الأصناف ويقارن أرصدتها بحد الطلب ' ويظهر رسالة تحذيرية إذا كان (الرصيد <= حد الطلب) Call CheckReorderLevels End Sub Sub CheckExpiryDates() Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions") Dim lastRow As Long, i As Long Dim expiryDate As Date Dim msg As String Dim monthsLimit As Integer: monthsLimit = 3 lastRow = wsTrans.Cells(wsTrans.Rows.Count, 1).End(xlUp).Row msg = "تنبيه: الأصناف التالية ستنتهي صلاحيتها خلال 3 أشهر:" & vbCrLf For i = 2 To lastRow ' التحقق من وجود تاريخ صلاحية في العمود J If IsDate(wsTrans.Cells(i, 10).Value) Then expiryDate = wsTrans.Cells(i, 10).Value ' حساب الفرق بين تاريخ اليوم وتاريخ الصلاحية ' DateDiff("m", ...) يحسب الفرق بالشهور If DateDiff("m", Date, expiryDate) <= monthsLimit And expiryDate >= Date Then msg = msg & "- " & wsTrans.Cells(i, 6).Value & " (تنتهي في: " & expiryDate & ")" & vbCrLf End If End If Next i If msg <> "تنبيه: الأصناف التالية ستنتهي صلاحيتها خلال 3 أشهر:" & vbCrLf Then MsgBox msg, vbExclamation, "مراقبة الصلاحية" End If End Sub Private Sub TxtExpiry_Exit(ByVal Cancel As MSForms.ReturnBoolean) If TxtExpiry.Value <> "" Then If Not IsDate(TxtExpiry.Value) Then MsgBox "يرجى إدخال التاريخ بصيغة صحيحة (DD/MM/YYYY)", vbCritical Cancel = True End If End If End Sub Sub ExportExpiryReportToPDF() Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions") Dim wsTemp As Worksheet Dim lastRow As Long, i As Long, targetRow As Long Dim fileName As String ' إنشاء شيت مؤقت للتقرير Set wsTemp = Worksheets.Add wsTemp.Name = "Expiry_Report_Temp" ' وضع العناوين wsTemp.Range("A1:D1").Value = Array("الصنف", "المخزن", "الكمية", "تاريخ الصلاحية") wsTemp.Range("A1:D1").Font.Bold = True targetRow = 2 lastRow = wsTrans.Cells(wsTrans.Rows.Count, 1).End(xlUp).Row ' فلترة الأصناف التي ستنتهي خلال 90 يوم For i = 2 To lastRow If IsDate(wsTrans.Cells(i, 10).Value) Then If wsTrans.Cells(i, 10).Value - Date <= 90 And wsTrans.Cells(i, 10).Value >= Date Then wsTemp.Cells(targetRow, 1).Value = wsTrans.Cells(i, 6).Value ' الصنف wsTemp.Cells(targetRow, 2).Value = wsTrans.Cells(i, 4).Value ' المخزن wsTemp.Cells(targetRow, 3).Value = wsTrans.Cells(i, 9).Value ' الكمية wsTemp.Cells(targetRow, 4).Value = wsTrans.Cells(i, 10).Value ' الصلاحية targetRow = targetRow + 1 End If End If Next i ' تنسيق الجدول wsTemp.Columns("A:D").AutoFit ' مسار الحفظ (سطح المكتب) fileName = Environ("USERPROFILE") & "\Desktop\تقرير_الصلاحية_" & Format(Date, "yyyy-mm-dd") & ".pdf" ' تصدير إلى PDF wsTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileName ' حذف الشيت المؤقت Application.DisplayAlerts = False wsTemp.Delete Application.DisplayAlerts = True MsgBox "تم تصدير تقرير PDF بنجاح إلى سطح المكتب باسم: " & vbCrLf & fileName, vbInformation End Sub Sub ExportExpiryToWord() Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions") Dim objWord As Word.Application Dim objDoc As Word.Document Dim objTable As Word.Table Dim i As Long, lastRow As Long, targetRow As Long ' إنشاء تطبيق Word جديد Set objWord = New Word.Application objWord.Visible = True ' جعل الوورد مرئياً Set objDoc = objWord.Documents.Add ' إضافة عنوان للمستند With objWord.Selection .Font.Size = 18 .Font.Bold = True .ParagraphFormat.Alignment = wdAlignParagraphCenter .TypeText "تقرير الأصناف التي تقترب صلاحيتها من الانتهاء" .TypeParagraph .Font.Size = 12 .Font.Bold = False .ParagraphFormat.Alignment = wdAlignParagraphRight .TypeText "تاريخ التقرير: " & Date .TypeParagraph: .TypeParagraph End With ' حساب عدد الصفوف التي تنطبق عليها الشروط أولاً لتحديد حجم الجدول lastRow = wsTrans.Cells(wsTrans.Rows.Count, 1).End(xlUp).Row targetRow = 1 ' إضافة جدول (بشكل مبدئي بصف واحد للعناوين) Set objTable = objDoc.Tables.Add(objWord.Selection.Range, 1, 4) objTable.Borders.Enable = True objTable.Cell(1, 1).Range.Text = "الصنف" objTable.Cell(1, 2).Range.Text = "المخزن" objTable.Cell(1, 3).Range.Text = "الكمية" objTable.Cell(1, 4).Range.Text = "تاريخ الصلاحية" objTable.Rows(1).Range.Font.Bold = True objTable.Rows(1).Shading.BackgroundPatternColor = wdColorGray10 ' ملء الجدول بالبيانات المفلترة For i = 2 To lastRow ' فحص الصلاحية (أقل من 90 يوم) If IsDate(wsTrans.Cells(i, 10).Value) Then If wsTrans.Cells(i, 10).Value - Date <= 90 And wsTrans.Cells(i, 10).Value >= Date Then objTable.Rows.Add targetRow = objTable.Rows.Count objTable.Cell(targetRow, 1).Range.Text = wsTrans.Cells(i, 6).Value objTable.Cell(targetRow, 2).Range.Text = wsTrans.Cells(i, 4).Value objTable.Cell(targetRow, 3).Range.Text = wsTrans.Cells(i, 9).Value objTable.Cell(targetRow, 4).Range.Text = wsTrans.Cells(i, 10).Value End If End If Next i ' رسالة تأكيد MsgBox "تم إنشاء مستند Word وتصدير البيانات بنجاح!", vbInformation End Sub Sub UndoTransfer() Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions") Dim transID As Variant Dim foundRow As Variant Dim confirm As VbMsgBoxResult ' طلب رقم الإذن المراد التراجع عنه transID = InputBox("يرجى إدخال رقم الإذن (التحويل) المراد التراجع عنه:", "تراجع عن عملية") If transID = "" Then Exit Sub ' إلغاء في حال لم يتم إدخال رقم ' البحث عن رقم الإذن في العمود الثاني foundRow = Application.Match(CLng(transID), wsTrans.Columns(2), 0) If IsError(foundRow) Then MsgBox "عذراً، رقم الإذن غير موجود!", vbCritical Exit Sub End If ' التأكد أن العملية هي "تحويل" If wsTrans.Cells(foundRow, 3).Value <> "تحويل" Then MsgBox "هذا الإذن ليس عملية تحويل، لا يمكن التراجع عنه بهذا الزر!", vbExclamation Exit Sub End If ' تأكيد الحذف confirm = MsgBox("هل أنت متأكد من التراجع عن هذا التحويل؟" & vbCrLf & _ "سيتم حذف السجل وإعادة الكمية للمخزن المصدر.", vbQuestion + vbYesNo, "تأكيد") If confirm = vbYes Then wsTrans.Rows(foundRow).Delete MsgBox "تم التراجع عن العملية بنجاح وتحديث المخزون.", vbInformation ' تحديث أي قوائم أو تقارير مفتوحة Call UpdateListBox End If End Sub Sub UndoTransferWithAudit() Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions") Dim wsAudit As Worksheet: Set wsAudit = Sheets("Audit_Log") Dim transID As Variant Dim foundRow As Variant Dim nextAuditRow As Long transID = InputBox("أدخل رقم الإذن للتراجع عنه:", "نظام الرقابة") If transID = "" Then Exit Sub ' البحث عن السجل foundRow = Application.Match(CLng(transID), wsTrans.Columns(2), 0) If Not IsError(foundRow) Then ' 1. تسجيل البيانات في سجل المراقبة قبل الحذف nextAuditRow = wsAudit.Cells(wsAudit.Rows.Count, 1).End(xlUp).Row + 1 With wsAudit .Cells(nextAuditRow, 1).Value = Now ' التاريخ والوقت الحالي .Cells(nextAuditRow, 2).Value = wsTrans.Cells(foundRow, 2).Value ' رقم الإذن .Cells(nextAuditRow, 3).Value = wsTrans.Cells(foundRow, 6).Value ' الصنف .Cells(nextAuditRow, 4).Value = wsTrans.Cells(foundRow, 9).Value ' الكمية .Cells(nextAuditRow, 5).Value = wsTrans.Cells(foundRow, 4).Value ' المخزن المصدر .Cells(nextAuditRow, 6).Value = Application.UserName ' اسم مستخدم الكمبيوتر .Cells(nextAuditRow, 7).Value = "تراجع/حذف تحويل" End With ' 2. تنفيذ الحذف الفعلي wsTrans.Rows(foundRow).Delete MsgBox "تم التراجع وتسجيل العملية في سجل الرقابة.", vbInformation Else MsgBox "رقم الإذن غير موجود!", vbCritical End If End Sub Sub FillUndoList() Dim ws As Worksheet: Set ws = Sheets("Transactions") Dim lastRow As Long, i As Long ListBox2.Clear ListBox2.ColumnCount = 4 ListBox2.ColumnWidths = "50;80;80;50" ' رقم الإذن، الصنف، من، إلى lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' عرض آخر 10 حركات تحويل فقط لسهولة التراجع For i = lastRow To 2 Step -1 If ws.Cells(i, 3).Value = "تحويل" Then With ListBox2 .AddItem ws.Cells(i, 2).Value ' رقم الإذن .List(.ListCount - 1, 1) = ws.Cells(i, 6).Value ' اسم الصنف .List(.ListCount - 1, 2) = ws.Cells(i, 4).Value ' من مخزن .List(.ListCount - 1, 3) = ws.Cells(i, 9).Value ' الكمية End With End If If ListBox2.ListCount > 10 Then Exit For Next i End Sub Private Sub CommandButton_Undo_Click() Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions") Dim wsAudit As Worksheet: Set wsAudit = Sheets("Audit_Log") Dim transID As Long Dim foundRow As Variant Dim nextAuditRow As Long ' التأكد من اختيار حركة من القائمة If ListBox2.ListIndex = -1 Then MsgBox "يرجى اختيار حركة من القائمة أولاً!", vbExclamation Exit Sub End If ' الحصول على رقم الإذن من العمود الأول في الـ ListBox transID = ListBox2.List(ListBox2.ListIndex, 0) ' البحث عن السجل في شيت الحركات foundRow = Application.Match(transID, wsTrans.Columns(2), 0) If Not IsError(foundRow) Then ' 1. تسجيل العملية في الـ Audit Log المخفي nextAuditRow = wsAudit.Cells(wsAudit.Rows.Count, 1).End(xlUp).Row + 1 wsAudit.Cells(nextAuditRow, 1).Value = Now wsAudit.Cells(nextAuditRow, 2).Value = transID wsAudit.Cells(nextAuditRow, 6).Value = Application.UserName wsAudit.Cells(nextAuditRow, 7).Value = "تراجع عبر اليوزرفورم" ' 2. حذف السجل wsTrans.Rows(foundRow).Delete MsgBox "تم التراجع عن التحويل رقم " & transID & " بنجاح.", vbInformation ' 3. تحديث القائمة فوراً Call FillUndoList End If End Sub

استخدم هذا <><><><><> If Len(Nz(Me.Image.Picture, "")) = 0 Or Dir(Me.Image.Picture) = "" Then Beep MsgBox "لا يمكن طباعة هذا التقرير بدون صورة شخصية ((يرجى اضافة صورة شخصية))" Else RName = "Personel" FldCriteria = "[Key]=" & Me![Key] DoCmd.OpenReport RName, acViewNormal, , FldCriteria End If

من يساعدنى فى عمل برنامج محاسبى بيع شراء تحويل الدليل المختصر هو ما يضمن استمرارية العمل وحماية النظام من سوء الاستخدام. إليك دليل المستخدم الموحد المصمم ليوضع في شيت باسم "التعليمات" أو يطبع للموظفين: 📘 دليل مستخدم برنامج إدارة المخازن الاحترافي 1️⃣ تسجيل حركة جديدة (إضافة / تحويلات / بيع / شراء) افتح لوحة التحكم واضغط على زر "إضافة حركة". سيقوم البرنامج بإنشاء رقم إذن تلقائي وتاريخ اليوم. اختر نوع الحركة؛ سيقوم النظام بتكييف الخيارات بناءً على اختيارك. اختر المخزن ثم الصنف. سيظهر لك "الرصيد المتاح" فوراً أسفل الصنف. أدخل الكمية؛ إذا تجاوزت الرصيد المتاح في عمليات الصرف، سيتحول لون الخانة للأحمر ويمنعك النظام من الحفظ. اضغط حفظ؛ سيتم ترحيل البيانات وتحديث التقارير فوراً. 2️⃣ عملية التحويل بين المخازن عند اختيار نوع الحركة "تحويل"، سيظهر لك تلقائياً خانة "المخزن المحول إليه". تأكد من اختيار مخزن المصدر (من) ومخزن الهدف (إلى). سيقوم البرنامج بخصم الكمية من الأول وإضافتها للثاني في خطوة واحدة. 3️⃣ التراجع عن العمليات (التصحيح) من داخل اليوزرفورم، انتقل إلى قائمة "التراجع عن الحركات". ستظهر لك قائمة بآخر 10 تحويلات تمت. حدد الحركة التي تريد إلغاءها من القائمة واضغط "تراجع عن الحركة". تنبيه: أي عملية تراجع يتم تسجيلها سرياً في "سجل المراقبة" باسم المستخدم ووقت الحذف. 4️⃣ إدارة تواريخ الصلاحية وحد الطلب عند إدخال صنف جديد، تأكد من إدخال تاريخ الصلاحية. عند فتح الملف، سيعطيك البرنامج تنبيهاً تلقائياً بالأصناف التي ستنتهي خلال 3 أشهر. إذا قل رصيد صنف عن "حد الطلب" المعرف في الإعدادات، سيظهر لك تنبيه بضرورة إعادة الشراء. 5️⃣ استخراج التقارير جرد المخازن: يعطيك الأرصدة الحالية مقسمة (كرتونة / قطعة). كرت الصنف: لمتابعة حركة صنف معين في فترة زمنية محددة. تصدير التقرير: يمكنك تصدير تقارير الصلاحية والنواقص بضغطة زر إلى PDF للإرسال أو Word للتعديل. ⚠️ تعليمات هامة للمدير: تحديث البيانات: لإضافة صنف جديد أو مخزن جديد، اذهب لشيت Setup وأضفه في القائمة. كلمة المرور: لا تشارك كلمة مرور محرر VBA مع الموظفين لضمان عدم عبثهم بالأكواد. الأمان: شيت Audit_Log مخفي تماماً؛ يمكنك الإطلاع عليه من خلال محرر الأكواد فقط لمراقبة عمليات الحذف. هل اكتملت الصورة لديك الآن؟

اخي الكريم الاوفيس عندي عربي و عندك انكليزي الاشهر عندي بالاسم العربي و عندك بالاسم الانكليزي جرب غير الاوفيس الى الواجهة العربية و غير اعدادات التقويم الى الميلادي عربي ووافني بالنتيجة جزاك الله كل خير

اين الردود?؟؟؟؟؟؟؟?؟

السلام عليكم : في الملف المرفق لدية زر امر لطباعة تقرير طبعا انا عامل كود لطباعة التقرير بشرط يكون امتداد الصورة في (Pic1) موجود يعني التقرير يحتوي على صورة الفرد وتتم الطباعة وفي حالة عدم وجود امتداد للصورة في (Pic1) لا يطبع تقرير. السؤال : هل يصح تغيير الشرط من (Pic1) الى مربع حوار الصورة (Image) اذا كان (Image) يحتوي على صورة اثناء فتج النموذج تتم الطباعة وذا كان لا يحتوي على صور لا تتم الطباعة طبعا انا جاولت التعديل بمفهومي البسيط ولم انجح .... مع فائق الشكر والتقدير Database.rar

يبدو المشكلة في الورد لاني جربتها على جهاز اخر فتمت العملية بنجاح والان هل من فكرة يتم تحويل المبلغ ماليا وليس رقم مثلا في الاكسس. 4.390.000.00ينقلها في الورد 4390000

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

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

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

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

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

يُعد بروبوزال ماجستير جاهز مفتاح القبول في برامج الدراسات العليا؛ حيث يعكس قوة الفكرة البحثية وجدّيتها منذ اللحظة الأولى، البروپوزال المتميز يجمع بين الوضوح والإقناع والمنهجية العلمية الدقيقة؛ ومن خلال شركة إتقان للاستشارات الأكاديمية والتدريب نضمن لك إعداد بروبوزال احترافي يلفت انتباه لجان القبول، مع خدمات متكاملة تشمل أيضًا إعداد خطة بحث تخرج بكالوريوس ودعم أكاديمي شامل حتى تحقيق هدفك.

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

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

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

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

تُعتبر خطة بحث تخرج بكالوريوس حجر الأساس لأي مشروع تخرج ناجح، فهي الخريطة التي تقود الطالب من فكرة أولية إلى بحث علمي متكامل يعكس جهده وتميّزه، الخطة الجيدة لا تكتفي بعرض الموضوع فقط، بل توضح المشكلة البحثية وأهميتها والمنهج العلمي المستخدم بأسلوب أكاديمي منظم وجذاب، ومع شركة إتقان للاستشارات الأكاديمية والتدريب يتحول القلق إلى ثقة؛ حيث نوفر إعداد خطط بحث دقيقة تلبي متطلبات الجامعات، مع دعم شامل يشمل نموذج خطة بحث جاهزة pdf يساعدك على الانطلاق بثبات.

اعرض الملف تحديث لموضوع الحل الشافي لتقارير اكسس {سلسلة الأدوات المساعدة المخصصة} الحقيقة أن هذا الموضوع ماهو إلا تحديث للموضوع الذي كنت قد رفعته للمنتدى منذ زمن طويل ولكني حبذت أن أفتح له موضوع جديد هنا في المكتبة لسببين الأول إثراءاً لمكتبة الموقع وتسهيل الوصول إليه لكل من يبحث عن موضوع التقارير والثاني لأني قمت بإجراء بعض التحسينات في الملف من حيث تبسيط الإجراءات وإرفاق شروحات وتعليمات توضيحية لطريقة العمل بهذه الأداة وخلافاً لما جرت عليه العادة فهذه الأداة لاتحتاج إلا إستيراد وحدة نمطية واجدة لذلك لم أرفق ملف بإسم القالب فكل ما ستحتاج إليه سيكون موجود في الملف المرفق تحياتي صاحب الملف منتصر الانسي تمت الاضافه 01/14/26 الاقسام قسم الأكسيس  

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

هذا لأن الكود يتعامل مع الوورد إصدار 2003 لذا قم بإضافة حرف x لإمتداد ملف الوورد بمعنى بدل هذا السطر OpenClsword (CurrentProject.Path & "\123.doc") إلى هذا السطر OpenClsword (CurrentProject.Path & "\123.docx")