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

تكبير حجم خط شريط الصيغة طلب منى على الرابط التالى

Sub Printing() 'تعريف متغير من النوع رقم صحيح لاستخدامه في الحلقة التكرارية Dim i As Long 'حلقة تكرارية من الرقم 1 وهو رقم أول طالب 'ونهاية الحلقة التكرارية هو عدد إجمالي الطلاب 'حيث يتم الحصول على هذا العدد من خلال إجمالي صفوف النطاق 'يمكن الإطلاع على النطاق من خلال [name1a] المسمى 'حيث يمثل [Name Manager] ثم [Formulas]التبويب 'والنطاق ديناميكي أي يتغير بإضافة طلاب جدد [D3:D26] النطاق For i = 1 To [name1a].Rows.Count 'في ورقة العمل المراد طباعتها ستتغير في كل حلقة تكرارية [D3] الخلية 'حيث تم استخدام الدالة إندكس للحصول على الطلاب بالترتيب 'في أول حلقة تكون قيمة المتغير تساوي 1 فيأتي بالطالب رقم 1 'وفي الحلقة التالية تتغير قيمة المتغير لتصبح 2 فيأتي بالطالب رقم 2 وهكذا [D3] = Application.Index([name1a], i) 'بمجرد تغير الطالب يتم إعطاء أمر بطباعة الورقة النشطة ActiveSheet.PrintOut Copies:=1 'الانتقال للحلقة التالية أي الطالب التالي Next i 'في نهاية المطاف يتم إرجاع قيمة الخلية لتساوي اسم أول طالب [D3] = Application.Index([name1a], 1) End Sub

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

السلام عليكم ورحمة الله وبركاته من الله علي بطريقة لعمل Tool bar او Ribbon Bar مثل البرامج الاحترافية وهي كالتالي وأسأل الله ان تفيد الجميع عمل Tab control في رأس انموذج ثم اضافة التبويبات حسب التصنيف الذي ترغب فيه مثلا تبويب للعملاء وتضيف اليه جميع الازرار الخاصة بالنماذج والتقارير ثم تبويب اخر للموردين وتضيف اليه كذلك ما تريد من ازرار ثم بعد الانتهاء من اضافة التبويبات المطلوبة تذهب الي خصائص الTab Control وتذهب الي خاصية Back style وتجعلها Transparent وبدلا من الازرار التقليدية يمكنك اضافة صورة واضافة امر لها عند النقر ولاضافة خاصية اخري يمكنك جعل المؤشر عند المرور علي الصورة ان يظهر شكل اليد لتكون افضل شكلا مرفق مثال ومدرج به موديول خاص بتغيير شكل المؤشر لشكل اليد عند المرور علي الصورة اي استفسار انا تحت امر الجميع مع خالص الشكر لاعضاء المنتدي المحترمين واسال الله ان ينفع بهذا العمل وان يجعله خالص لوجهه الكريم مرفق المثال Test.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

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

الرقم وتكراراته بنفس اللون لكن فيه شرط لو فيه رقم بالعمود الاول ولايوجد له شبيه بالعمود التاني نتركه بدون تلوين ثانيا لو الرقم في العمود الاول موجود مرتان مثلا وفي العمود التاني موجود 6 مرات مثلا نلون الرقم مرتان فقط في العمود الاو ل ومرتان في العمود التاني ويتبقى الرقم 4 مرات مكرر لكن غير ملون استاذ سليم ستتم التجربه ============================================= لم الحظ اي تغيير استاذ سليم ============================ استاذ ياسر نعم صح تاكيد ماتفضلت به من قول

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

جزاكم الله خيراً أخي الغالي أستاذنا الجليل // ياسر خليل شرح رائع وواف للكود تقبل وافر تقديري واحترامي

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

أخى فى الله وأستاذى الكبير // ياسر العربى بوركتم وجزيتم عنى خيرا ، نحمد الله وأشكركم على سؤالكم وسؤال الأخ الغالي الخلوق // حسام عيسى وتحياتى لكم شاكرا لكم إيصال السلام والإطمئنان وتقبل منى وافر الاحترام والتقدير

حبيى ابو العربى ده كدة مش رضا وبس دا أنا ابوس إيدى وإيدك وش وظهر على هذة الروح الطيبة شاكر فضلك وفضل الجميع وجزاكم الله خيرا

أشكرك Shivan Rekany على شرح ومساعدتك

أخى الكريم اليكم الملف بالمرفقات بعد التعديل لعله المطلوب تجد جدول فيه الإحصائيات المطلوبة جمع مع فلترة___1.rar

الموضوع بسيط بالدالة SUBTOTAL تفضل اما بخصوص ظهور الصفر من عدمه لم افهم طلبك هل تحتاج الصفر ام لا ؟ جمع مع فلترة.rar

اتفضل انسخ هذا في وحدة نمطية Option Compare Database Global Const SW_HIDE = 0 Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Function fSetAccessWindow(nCmdShow As Long) Dim loX As Long Dim loForm As Form loX = apiShowWindow(hWndAccessApp, nCmdShow) End Function وفي نموذج حيف فتح النموذج البداية اكتب هذا كود fSetAccessWindow(0) او call fSetAccessWindow(0)

حين تضغط على المعاينة بيفتح نموذج اخر لكي تختار فيها السنة وبها زر اخر كتبت كود استاذ جعفر في خلف ذاك الزر لكن غيرت هذا السطر فقط stLinkCriteria = "EmployeeID=" & Me.EmployeeID بهذا stLinkCriteria = "EmployeeID=" & Forms!frmmenah.EmployeeID

أخى فى الله وأستاذى القدير // ياسر خليل أبو البراء جزيتم عنا خير الخير شرحكم للكود أكثر من واف ورائع ويدل على شخصيتكم الراقية

اتفضل التكه ويبقى كدا رضا Private Const Nm As String = "dd.jpg" Public Sub Ali_Pr() Dim Pth As String, msg As String, x Dim arr(), sh arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13) For sh = LBound(arr) To UBound(arr) Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth With Sheets(arr(sh)).PageSetup .CenterHeader = "&G" If .Orientation = xlPortrait Then .HeaderMargin = Application.InchesToPoints(3) ElseIf .Orientation = xlLandscape Then .HeaderMargin = Application.InchesToPoints(3.5) End If End With Next msg = MsgBox("هل تريد طباعة الشيتات", vbYesNo, "امر طباعة") If msg = vbYes Then x = InputBox("عدد مرات الطباعة", "عدد نسخ الطباعة") Sheets(arr).PrintOut Copies:=x For sh = LBound(arr) To UBound(arr) Sheets(arr(sh)).Range("A9:V" & Sheets(arr(sh)).Cells(Rows.Count, 1).End(xlUp).Row).ClearContents Next End If MsgBox "Done....(-_-)..." End Sub تحياتي

اكتب هذه المعادلة في J5 ثم اسحب يميناً و الى اسفل =COUNTIFS($A$2:$A$24,$I5,$B$2:$B$24,J$4)

ضع المعادلة التالية في الخلية J5 =SUMPRODUCT(($A$2:$A$24=$I5)*($B$2:$B$24=J$4)) ثم قم بسحبها لأسفل ولليمين إذا لم تعمل المعادلة قم باستبدال الفاصلة العادية بفاصلة منقوطة تقبل تحياتي

لا يحتاج للشرح فقط شوف نظرا جيدا الى هذا الكود CurrentDb.Execute ("UPDATE qrymaelomat SET done =" & Not Me.done) Me.Requery واليك ملف حسب طلبك تحديد سجلات اللي تريد ويظهر في استعلام.rar

في زر فتح التقرير اكتب هذا الكود قبل كود فتح التقرير DoCmd.RunCommand acCmdRefresh واليك ملف بعد تعديل تحديد سجلات اللي تريد ويظهر في استعلام.rar

تفضل حبيبي Private Const Nm As String = "dd.jpg" Public Sub Ali_Pr() Dim Pth As String, msg As String, x Dim arr(), sh arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13) For sh = LBound(arr) To UBound(arr) Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth With Sheets(arr(sh)).PageSetup .CenterHeader = "&G" If .Orientation = xlPortrait Then .HeaderMargin = Application.InchesToPoints(3) ElseIf .Orientation = xlLandscape Then .HeaderMargin = Application.InchesToPoints(3.5) End If End With Next msg = MsgBox("هل تريد طباعة الشيتات", vbYesNo, "امر طباعة") If msg = vbYes Then x = InputBox("عدد مرات الطباعة", "عدد نسخ الطباعة") Sheets(arr).PrintOut Copies:=x End If MsgBox "Done....(-_-)..." End Sub تحياتي

بعد اذن الاخوة الكرام تفضل اخي تعديل بسيط لتطبيق على الشيتات دفعه واحده Private Const Nm As String = "dd.jpg" Public Sub Ali_Pr() Dim Pth As String Dim arr(), sh arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13) For sh = LBound(arr) To UBound(arr) Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth With Sheets(arr(sh)).PageSetup .CenterHeader = "&G" If .Orientation = xlPortrait Then .HeaderMargin = Application.InchesToPoints(3) ElseIf .Orientation = xlLandscape Then .HeaderMargin = Application.InchesToPoints(3.5) End If End With Next MsgBox "Done....(-_-)..." End Sub الشيتات المراد التعديل عليها داخل مصفوفة تستطيع تحديد اي شيتات تريد تحياتي

السلام عليكم ورحمة الله أخي الكريم، يجب أيضا تغيير الأمر .CenterHeader = "&G" بالأمر .CenterHeader = "" كما فعلتُ في الملف المرفق وسميت الكود Omar_Pr... بن علية علامة مائية مميزة.rar

الدرس السادس: الدوال النصية هنالك الكثير من الدوال المستعملة في VBA و سوف نحاول ذكر الدوال المشهورة منها حسب عملها: Asc: إرجاع عدد صحيح يمثل رمز الحرف الأول في السلسلة النصية. مثال: Me.y = Asc("أوفيسنا") النتيجة=195 Chr: تحويل عدد صحيح إلى حرف أو رمز. مثال: Me.y = Chr("210") النتيجة=ز InStr: استخراج موضع بداية سلسلة ضمن سلسلة أخرى. مثال: Instr(المقارنة,السلسلةالمبحوث عنها,السلسلة التي يتم فيها البحث,مكان بداية البحث) Me.y = InStr(1,"homsalah", "a")=5 InStrRev: إرجاع موضع تواجد سلسلة ضمن سلسلة أخرى بدءا من نهاية السلسلة. InStrRev(المقارنة,بداية البحث,السلسلة المبحوث عنها,السلسلة) Me.y = InStrRev("homsalah", "a", -1)=7 LCase: تحويل حروف سلسلة إلى حروف صغيرة. مثال: Me.y = LCase("ABC")=abc UCase: تحويل الأحرف إلى أحرف كبيرة. مثال: UCase(السلسلة النصية) Me.y = UCase("abcd")="ABCD" Left: ارجاع جزء من سلسلة حرفية حسب عدد الحروف المطلوبة من جهة اليسار. مثال: Left(عدد الأحرف المطلوبة,السلسلة ) Me.y = Left("1999", 2)=19 Len: حساب عدد الأحرف في السلسلة. مثال: len(السلسلة) Me.y = Len("1999")=4 LTrim: حذف الفراغات الموجودة في الجهة اليسرى. مثال: Trim(السلسلة) Me.y = Trim(" 1999")="1999" Mid: ارجاع جزء من سلسلة بحيث تحدد بداية الجزء و طوله (عدد الأحرف). مثال: Mid(عدد الأحرف,نقطة البداية(رقم),السلسلة) Me.y = Mid("SALAH", 3, 2)="LA" Replace: تعويض جزء من سلسلة بجزء آخر. مثال: Replace(الجزء المعوض,الجزء الذي نريد استبداله,السلسلة) Me.y = Replace("SALAH", "H", "T")="SALAT" Right: ارجاع جزء من سلسلة حرفية حسب عدد الحروف المطلوبة من جهة اليمين. مثال: Right(عدد الحروف,السلسلة) Me.y = Right("SALAH", 2)="AH" RTrim: حذف الفراغات الموجودة في الجهة اليمنى لسلسلة. مثال: RTrim(السلسلة) Me.y = RTrim("15 ")="15" Trim: حذف المسافات البادئة و الزائدة من سلسلة. مثال: Trim(السلسلة) Me.y = Trim(" 15 ")="15" Space: ارجاع سلسلة تتألف من عدد من المسافات المحددة. مثال: Space(عدد الفراغات) Me.y = Space(3)=" " Str: ارجاع متغير من نوع string يمثل رقم.(تحويل متغير من نوع رقم إلى متغير من نوع سلسلة نصية) مثال: Str(العدد) Me.y = Str(3)=" 3" Me.y = Str(-3)="-3" تقوم بإرجاع مسافة قبل الأعداد الموجبة StrComp: ارجاع عدد صحيح يشير إلى نتيجة مقارنة سلسلتين.إذا كانت متساوية يرجع 0 و إذا كانت مختلفة يرجع 1 أو 1- مثال: StrComp(السلسلة2,السلسلة1,المقارنة) Me.y = StrComp("ass", "ass")=0 Me.y = StrComp("as", "ass")=-1 StrConv: ارجاع سلسلة تم تحويلها كما هو محدد. مثال: StrConv(رقم يمثل رمز التحويل,السلسلة,LCID) Me.y = StrConv("ass", 1)="ASS" رموز التحويل: 1: يحول السلسلة إلى أحرف كبيرة 2: يحول السلسلة إلى أحرف صغيرة 3: يحول الحرف الأول من كل كلمة في السلسلة إلى حرف كبير 64: تحول السلسلة إلى Unicode باستخدام مخطط الشفرة الافتراضي للنظام. 128: تحول السلسلة إلى Unicode باستخدام مخطط الشفرة الافتراضي للنظام. و هذا الرابط به مختلف الرموز: https://support.office.com/ar-SA/article/الدالة-StrConv-19c3816f-dbc9-4adf-891c-fd32734c92e0 String: تكرار أحرف بعدد معين. مثال: String(الحرف, عدد التكرارات) Me.y = String(3, "S")="SSS" StrReverse: قلب ترتيب أحرف سلسلة نصية. مثال: StrReverse(السلسلة) Me.y = StrReverse("ABCD")="DCBA"

هداياك متميزة , "جعفر" شمس لا تغيب عن سماء أوفيسنا

أخى الكريم إطلع على الملف المرفق حركة الدواء_11.rar

أخى الكريم الأستاذ // محمد الدسوقى يبدو أنك لم تأخذ بالك من الجملة المذكورة بتعليقى السابق ((((((((( وتم ربط المعادلات بالقائمة المنسدلة لتتغير النتائج ))))))))))) يجب تغير القائمة المنسدلة (( نصف العام & آخر العام )) لتغيير النتائج لأنها تقوم بتبديل صفوف أعمدة المواد المسجلة بالصف الثانى والثالث ( بدءا من F2 & F3 )وتظهر النتائج بالصف الأول بدءا من ( F1 ) كما ذكرت سابقا وتم ربط نتيجة المعادلة الموجودة بالصف الأول بمعادلات الشهادة والملف الذى أرفقته يعمل الكود بدون أخطاء

أخى الكريم الأستاذ // محمد الدسوقى إليكم ما طلبتم توجد معادلة بأول سطر بالشهادة مرتبطه بالدرجات وتم إضافة الطباعه لنصف العام وآخر العام وتم ربط المعادلات بالقائمة المنسدلة لتتغير النتائج تجد عدد الناجحين مختلفين وكذلك الراسبين حتى تشاهد وتتأكد بتغير النتائج All Certificates print_ FORM OR ALL OR PDF _By _MZMELSHRIEF+PR_N_R_H_L.rar

أخى الكريم الأستاذ // ناصر تم إضافة المطلوب ( طباعه الكل & طباعه ناجح & طباعة راسب ) على نفس نموذج الأستاذ // محمد All Certificates print_ FORM OR ALL OR PDF _By _MZMELSHRIEF+PR_N_R.rar

أخى الكريم جزيتم عنى خيرا على دعاؤكم الطيب إليكم الملف بالمرفقات استدعاء بيانات بعد التعديل.rar

أخى الكريم إليك محاولة منى ضع هذا الكود فى موديول واربط زر التشغيل بـ START وزر الايقاف بـ STOP ولكنه سيعمل على خلية واحده B4 Dim NextTick As Date, t As Date Sub StartClock() t = Time Call TickTock End Sub Private Sub TickTock() Range("B4").Value = Format(Time - t, "hh:mm:ss") NextTick = Now + TimeValue("00:00:01") Application.OnTime NextTick, "TickTock" End Sub Sub StopClock() Application.OnTime earliesttime:=NextTick, procedure:="TickTock", schedule:=False End Sub

فيما يختص بشرح كود طباعة الشهادة ' بدء الكود بتحديد النطاقات الثابة ' const تستخدم لتحديد الثوابت ' اسم ورقة الشهادات Const ShName As String = "Certificates" ' رقم اول صف للشهادة Const FirstRow As Integer = 6 ' عدد صفوف الشهادة Const CountRow As Integer = 17 'عدد اعمدة الشهادة التي تريد اظهارها في الطباعة Const CountColumn As Integer = 17 ' خلية موقع الطالب لمعادلات الشهادة Const Range_Index As String = "A6" ' اسم ورقة البيانات Const Sh As String = "Data" ' نطاق الاسماء في ورقة البيانات Const MyNSearch As String = "C5:C44" ' الخلية التى بها عدد كل الطلاب تجدها بشيت الشهادة Const CountAll As String = "E1" ' متغيرين نعلن عنهم Dim MZM_Test As Boolean Dim MySheet As Worksheet Sub MZM_ALL() ' إيقاف تحديث الشاشة Application.ScreenUpdating = False ' استدعاء الكود MZM_ClearContents With MySheet ' اسم النطاق الثابت المعلن عنه سابقا (Range_Index)خلية موقع الطالب لمعادلات الشهادة .Range(Range_Index).Value = 1 ' استدعاء عمل الكود التالى مع الأخذ فى الاعتبار الثابت الذى قمنا بتعريفة وهى الخلية التى عدد اجمالى الطلاب Call MZM_Test_Fill(.Range(CountAll)) ' اذا كان المتغير المعلن عنه بأول الكود به بيانات بناء على خلية معادله الشهادة تم تنفيذ المطلوب مع استدعاء الكود بالسطر السابق اذن يتم تطبيق التالي ' يتم مسح النطاق للكتابه فيه مع عرض الطباعة If MZM_Test Then .PrintPreview Else .Range(Range_Index).ClearContents End With ' اعادة تحديث الشاشة Application.ScreenUpdating = True End Sub Sub MZM_Delete() ' إيقاف تحديث الشاشة Application.ScreenUpdating = False ' استدعاء عمل الكود التالى MZM_ClearContents ' اعادة تحديث الشاشة Application.ScreenUpdating = True ' حفظ العمل واظهار رسالة تفيد ذلك ThisWorkbook.Save MsgBox "تم مسح الشهادات وحفظ نطاق عمل الشهادة الرئيسية", vbMsgBoxRight, "الحمد لله الذى بنعمته تتم الصالحات" End Sub Sub MZM_ClearContents() ' متغير نعلن عنه Dim T As Long ' تخصيص متغير أعلن عنه سابقا Set MySheet = Sheets(ShName) With MySheet ' خلية موقع الطالب لمعادلات الشهادة وهو من الثوابت المعلن عنها سابقا يتم المسح مع الحفاظ على النموذج ( الشهادة الرئيسية) الذى يستخدم للنسخ كما هو .Range(Range_Index).ClearContents T = .UsedRange.Rows.Count .Rows(FirstRow + CountRow).Resize(T).Delete ' نطلب منه الوقوف على الخلية التى تم الاعلان عنها كثابت وهى خلية موقع الطالب لمعادلات الشهادة Application.GoTo .Range(Range_Index), True End With End Sub ' الكودين التاليين يختصوا بنسخ نطاق الشهادة بما فيها من معادلات وتنسيق مع رسالة توضح اذا كان لا يوجد معادلات Sub MZM_Test_Fill(MyCel As Range) If IsNumeric(MyCel) And MyCel.Value > 0 Then MZM_Test = True If MyCel.Value <> 1 Then Call MZM_AutoFill(MyCel.Value) Else MZM_Test = False MsgBox MyCel.Offset(0, -1) & Chr(10) & Chr(10) & MyCel, 524288 + 1048576 + 16, "بيانات غير متوفرة" End If End Sub Sub MZM_AutoFill(R As Integer) Dim SourceRange As Range, fillRange As Range Dim RR As Long RR = (R * CountRow) With MySheet Set SourceRange = .Rows(FirstRow).Resize(CountRow) Set fillRange = .Rows(FirstRow).Resize(RR) SourceRange.AutoFill fillRange, xlFillDefault .PageSetup.PrintArea = .Range("B" & FirstRow).Resize(RR, CountColumn).Address End With End Sub

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

أخى الكريم إليك ما طلبت ملحوظه تظهر لك شاشة دخول يطلب منك إدخال كلمة المرور وهى ( 80214 ) من اليسار لليمين بعد الدخول يظهر شيت الـ DATA به زر إظهار الفورم قم بالضغط عليه تظهر لك الفورم بها كل ما طلبت وزياده والملف بالمرفقات N1__1.rar

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

بعد اذن أخى الأستاذ / جلال أخى الكريم الأستاذ / عمرو توجد فكرة لنقل البيانات بدون زر وهى أن تضع فى حدث الصفحة المراد النقل إليها أو الإستعلام إسم الكود فمبجرد كتابة رقم الكود أو الصنف وتضغط على زر enter تأتى البيانات ففى المثال السابق اسم الكود Kh_Filter Private Sub Worksheet_SelectionChange(ByVal Target As Range) Kh_Filter End Sub

السلام عليكم نفس كلام اخي ابوعبدالله ، ولكن بطريقة انا متعود عليها ارجع الى نسختك الاولى ، ثم في صفحة VBA . وغير الاسم الى مثلا: . دائما غيّر اسم المشروع ، وابدا لا تسمي اسم المشروع Database او DB ، واستخدم السطر الثاني بدل الاول: 'With Application.FileDialog(msoFileDialogFilePicker) With Application.FileDialog(3) واحفظ عملك ، والسلام جعفر 558.backup.accdb.zip

السلام عليكم الاخ fathiahmed اهلا وسهلاً بك عضوا جديد في صرح اوفسينا التعليمي اراك اقتبست رد لم نفهم مالمراد او المطلوب وفقك الله

صحيح اخي ياسر بعض الاسطر حذفت سهواً جرب المرفق Kh_Srech_Al_##.rar