أ / محمد صالح

ضع هذه المعادلة في الخلية I4 =IF(B4="ماكينة 3",H4,IF(OR(B4="ماكينة 2",B4="ماكينة 5"),C4/(C4+C3)*H4,C4/(C4+C5)*H4)) إن شاء الله تكون هي المطلوب بالتوفيق

أخي الكريم بعض الملاحظات على الكود المعروض من حضرتك: * هذا السطر يقوم بكتابة ok في العمود 14 في كل صف سواء تحقق الشرط أو لم يتحقق لأن هذا السطر بعد نهاية if Sheets("po_rec").Cells(a, 14).Value = "ok" وأعتقد أنه من المفترض أن يتم تنفيذه إذا تحقق الشرط يعني قبل نهاية end if * ثانيا في جملة with يفترض أنك في العمود A وفي آخر صف مكتوب فكيف تنقل القيم في الصفوف السابقة (يفترض أنها مكتوب فيها) لأن ناتج الرقم الأول في offset بالسالب 4 - 21 = -17 ؟؟؟؟ ************ ورغم كل شيء: للخروج من الحلقة التكرارية for يمكنك كتابة exit for قبل سطر نهاية end if ولكن بعد معالجة الملاحظتين السابقتين

يجب أن تعمل استعلامين للنموذجين الفرعيين استعلام لكل نموذج فرعي والاستعلام في الكود هو هذه السطور Set rs = CurrentDb.OpenRecordset("SELECT TTa.asX, TTa.azX, TTB.Bc, TTB.Bd FROM TTa INNER JOIN TTB ON TTa.المعرف = TTB.Ba WHERE TTa.المعرف= " & المعرف & ";", dbOpenSnapshot) With rs .MoveLast .MoveFirst For I = 1 To .RecordCount bc = bc & IIf(bc = "", "", vbCrLf) & Nz(rs.Fields(2).Value, "") bd = bd & IIf(bd = "", "", vbCrLf) & Nz(rs.Fields(3).Value, "") .MoveNext Next I End With Set rs = Nothing طبعا مع تغيير جملة select لما يتناسب مع النموذج الفرعي الجديد

ما أجمل التعاون من أجل قضاء حوائج بعضنا البعض دمتم بخير أحبابي المشاركين وتفضل أخي الكريم هذا هو ملفك حسب الكود السابق لي تم إضافة أمر حفظ الملف باسم هذا الاسم هو رقم المعرف وتاريخ ووقت التصدير وعدم حفظ الملف الأصلي مع إغلاقه ‏‏إرسال الحقول للوورد bookmarks.rar

المطلوب الأخير غير واضح لي بصورة كافية إذا كنت تقصد إغلاق مستند الوورد بعد الكتابة فيه وإغلاق الوورد كله فهذا سهل يمكنك تغيير الإجراء الخاص بالزر إلى ما يلي: Dim X As Object, db As DAO.Database, rs As DAO.Recordset, bc As String, bd As String Set X = CreateObject("Word.Application") X.Documents.Open CurrentProject.Path & "\asdf.docx" X.Visible = True X.ActiveDocument.Bookmarks("asx").Select X.selection.InsertAfter AsX X.ActiveDocument.Bookmarks("azx").Select X.selection.InsertAfter azX Set db = CurrentDb Set rs = db.OpenRecordset("SELECT TTa.asX, TTa.azX, TTB.Bc, TTB.Bd FROM TTa INNER JOIN TTB ON TTa.ÇáãÚÑÝ = TTB.Ba WHERE TTa.ÇáãÚÑÝ= " & ÇáãÚÑÝ & ";", dbOpenSnapshot) With rs .MoveLast .MoveFirst For I = 1 To .RecordCount bc = bc & IIf(bc = "", "", vbCrLf) & Nz(rs.Fields(2).Value, "") bd = bd & IIf(bd = "", "", vbCrLf) & Nz(rs.Fields(3).Value, "") .MoveNext Next I End With Set rs = nothing Set db = nothing X.ActiveDocument.Bookmarks("bc").Select X.selection.InsertAfter bc X.ActiveDocument.Bookmarks("bd").Select X.selection.InsertAfter bd X.ActiveDocument.Close savechanges:=True X.Quit Set X = Nothing MsgBox "done" ما معنى مع ملاحظة أن ملف الوورد سيكون للقراءة فقط؟؟؟؟؟ الملفات التي للقراءة فقط لا يمكن الكتابة فيها سواء يدويا أو بالكود

تفضل أخي الكريم تم إنشاء bookmarks بنفس أسماء الحقول في ملف الوورد تم تعديل اسم الحقل bzX في النموذج كان اسمه bz فقط تم الدمج بين الكودين لكتابة أكثر من سطر بعد العلامة المرجعية بدلالة استعلام ولا تنسوني من دعواتكم الصالحة حيث أنني في أشد الاحتياج إليها هذه الأوقات ‏‏إرسال الحقول للوورد bookmarks.rar

رجاء تحويل المعادلة للصورة العادية أفضل من نمط R1C1 واستعمل هذا الكود تم إضافة شرط العمود لا يساوي 3 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 8 And Target.Column < 8 And Target.Column <> 3 Then Range("c" & Target.Row).Formula = "=a1+b1" Range("h" & Target.Row).Formula = "=IF(ISBLANK(A" & Target.Row & "),0,$B$7*F" & Target.Row & "*(1+G" & Target.Row & "))" Range("i" & Target.Row).Formula = "=IF(ISBLANK(A" & Target.Row & "),0,E" & Target.Row & "*H" & Target.Row & ")" End If End Sub ضع المعادلة مكان =a1+b1 مع استبدال رقم الصف ب Target.Row بالتوفيق

وفقنا الله جميعا لكل خير

يمكن الدمج بين الكودين لذا أعطني الشكل النهائي لملف الوورد بعد التصدير كيف سيكون؟

المشكلة في عدم وجود الدالة OpenClsword وإذا أمكنك تحويل الحقول التي تريد تصديرها إلى استعلام سيكون أسهل في تصديره إلى وورد وهذا ملفك بعد إضافة موديول التصدير إلى وورد إرسال الحقول للوورد.accdb

نفعنا الله جميعا بما علمنا وعلمنا ما ينفعنا وزادنا علما

الأخ الكريم qutubsi الأمر لا يحتاج إلى محاولات فقط تحويل الجداول إلى نطاقات وكما هو مكتوب في التعليمات المترجمة: تقوم بتحديد الجدول الموجود في sheet3 في الخلابا العمودين A & B سيظهر تبويب جديد اسمه تصميم الجدول design احتر تحويل إلى نطاق convert to range ويوجد جدول آخر في نفس الشيت في الخلايا D1:E24 كرر معه نفس الخطوات وستعمل معك المشاركة بإذن الله

تكمن المشكلة في أنك تقوم بعمل سلسلة لا نهائية من استدعاء الكود بحيث أن تقوم بتغيير المعادلة وهذا تغيير يتطلب تغيير المعادلة وهكذا وحل هذه المشكلة في تحديد نطاق التغيير مثلا بعد الصف 8 وقبل العمود 8 وعليه يكون الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 8 And Target.Column < 8 Then Range("h" & Target.Row).Formula = "=IF(ISBLANK(A" & Target.Row & "),0,$B$7*F" & Target.Row & "*(1+G" & Target.Row & "))" Range("i" & Target.Row).Formula = "=IF(ISBLANK(A" & Target.Row & "),0,E" & Target.Row & "*H" & Target.Row & ")" End If End Sub بالتوفيق

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

انا شخصيا اعالجها كالتالي : جدول الأصناف يحتوي على سعر الشراء وهو آخر سعر شراء وسعر البيع وهو آخر سعر بيع يتم تحديثهم (بالكود) من آخر فاتورة شراء حيث تحتوي على سعر الشراء وسعر البيع التي يملاها المستخدم نأتي في فاتورة البيع عندما يتم تحديد الصنف يتم جلب سعر البيع وتسجيله في حقل سعر الوحدة في تفاصيل فاتورة البيع (بالكود طبعا) وبهذا تكون جميع الفواتير تحتوي على سعر البيع وقتها بدون التأثر بآخر سعر الموجود في جدول الأصناف والله اعلم

المشكلة في هذا الجزء الذي ينسخ محتويات الاستعلام ويضعها في الخلية A6 في الشيت الحالي وحسب كلامك ينبغي معرفة آخر صف في شيت find ثم النسخ بعده sheets("find").range("a" & sheets("find").range("a" & rows.count).end(xlup).row + 1). CopyFromRecordset Recordset بالتوفيق

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

طبيعي جدا ألا يعمل الكود وأنت وضعته في موديول جديد هو فقط تعديل لكود الطباعة بطريقة أخرى: يوجد في كود الطباعة السطرين الخاصين بالتصدير إلى pdf والطباعة R.ExportAsFixedFormat Type:=xlTypePDF, Filename:="e:\pdf\" & "\" & fil_name sh.Range("a1:h30").PrintOut استبدلهما بما سبق يعني ضع قبلهما سطرين If [h1] = "" Then pp: وضع بعدهما الباقي [h1] = [h1] + 1 Else m = MsgBox("تمت الطباعة قبل ذلك" & Chr(10) & "هل تريد الطباعة مرة أخرى", vbYesNo, "تنبيه") If m = 6 Then GoTo pp End If وطبعا هذا على كلامك السابق لكن بعد تحديد (على أساس رقم المستند ) فالموضوع سيختلف تماما وهذا كود إجراء الطباعة والتصدير كاملا module4 Sub RectangleRoundedCorners222_Click() 'On Error Resume Next 'Sheets("حساب").Range("A1:h10").ExportAsFixedFormat xlTypePDF, Filename:="e:\pdf\" & Sheets("حساب").Range("b3").Value & Sheets("حساب").Range("a3").Value, openafterpublish:=True Dim sh As Worksheet Dim R Dim fil_name Set sh = ThisWorkbook.Worksheets("حساب") fil_name = sh.Range("b3") & " " & sh.Range("a3") Set R = sh.Range("a1:h10") If IsError(Application.Match(Range("a3"), Range("i:i"), 0)) Then pp: R.ExportAsFixedFormat Type:=xlTypePDF, Filename:="e:\pdf\" & "\" & fil_name & ".pdf" sh.Range("a1:h30").PrintOut Range("i" & Range("i" & Rows.Count).End(xlUp).Row + 1).Value = [a3] Else m = MsgBox("تمت الطباعة قبل ذلك" & Chr(10) & "هل تريد الطباعة مرة أخرى", vbYesNo, "تنبيه") If m = 6 Then GoTo pp End If End Sub بالتوفيق

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

ينبغي علينا أولا فهم الكود الخاص بك أخي الكريم معنى الكود أنك تبتصل ب 17 قاعدة بيانات جميعها باسم Database#01.accdb وموجودة في 17 مجلد اسم المجلد هو الخلايا من b2 إلى b18 ثم تستعلم من قاعدة البيانات وتضع ناتج الاستعلام في نفس الخلية a6 هل فهمي للكود صحيح؟ وما المطلوب تصحيحه ؟

جرب هذا التعديل: If [h1] = "" Then pp: R.ExportAsFixedFormat Type:=xlTypePDF, Filename:="e:\pdf\" & "\" & fil_name sh.Range("a1:h30").PrintOut [h1] = [h1] + 1 Else m = MsgBox("تمت الطباعة قبل ذلك" & Chr(10) & "هل تريد الطباعة مرة أخرى", vbYesNo, "تنبيه") If m = 6 Then GoTo pp End If وهو يقوم بإظهار رسالة إذا تم تفيير قيمة الخلية h1 إذا تمت الطباعة قبل ذلك

شكرا لكلماتك الطيبة خالص دعواتي بالتوفيق أخوك محمد صالــــــح

من تبويب إدراج insert اختر wordart

مقترح جميل وللوصول إلى هذا يلزمنا: * تعديل سطر رابط الملف في الكود إلى wmp.Url = ThisWorkbook.Path & "\" & "mp3" & "\" & ListBox1.Value & ".mp3" للاحظ أنه يقرأ قيمة العنصر المجدد وليس فهرسه * وكذلك يلزمنا تغيير خاصية rowsource الخاصة بالقائمة إلى =INDIRECT("a1:a"&COUNTA(A:A)) وتعني تحديد الخلايا المكتوب فيها فقط في العمود a ويمكنك كتابة أسماء الملفات بصورة نصية أيضا مثل سورة كذا

بالتوفيق للجميع هكذا يستمر صرح العطاء بلا مقابل ابتغاء وجه الله