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

وعليكم السلام تفضل أخي الكريم بالتوفيق aziz.accdb

جرب هذا الكود Option Explicit Sub Find_all() Dim S As Worksheet Dim D As Object Dim Ro%, k%, a, b, c Set S = Sheets("sheet1") Set D = CreateObject("Scripting.Dictionary") S.Range("E1").CurrentRegion.Offset(1).ClearContents Ro = S.Cells(Rows.Count, 2).End(3).Row With D k = 2 Do Until k = Ro + 1 If S.Range("B" & k) <> vbNullString Then Select Case S.Range("B" & k) Case "الشرقية": a = a + 1 Case "الغربية": b = b + 1 Case "القاهرة": c = c + 1 End Select If Not D.exists(S.Range("B" & k).Value) Then D.Add (S.Range("B" & k).Value), _ IIf(IsNumeric(S.Range("C" & k).Value), S.Range("C" & k).Value, 0) Else D(S.Range("B" & k).Value) = D(S.Range("B" & k).Value) + _ IIf(IsNumeric(S.Range("C" & k).Value), S.Range("C" & k).Value, 0) End If End If k = k + 1 Loop Cells(2, "E").Resize(.Count - 1) = _ Application.Transpose(.keys) Cells(2, "F").Resize(.Count - 1) = _ Application.Transpose(.Items) Cells(2, "G") = a Cells(3, "G") = b Cells(4, "G") = c .RemoveAll End With Set D = Nothing: Set S = Nothing End Sub الملف مرفق Example.xlsm

تستطبعين ان تظعي الاكواد في الجداول مباشرة وتسمى هذه الطريقة الحقل المحسوب (طريقة غير مرغوب العمل بها لانها محدودة ) لانه ببساطة لايمكن تحديث الحقل المحسوب او التعديل عليه من مكان اخر . افضل مكان لعمل الحسابات او العمليات الرياضية هي الاستعلامات حسب علمي مثال مرفق للست ام عهود عن حساب العمر او الخدمة بالاستعلامات المشرفين على الموقع والاخوة هنا متعاونين جدا بارك الله فيهم وفي جهودهم لمساعدة الاخرين ان شاء الله سوف تكملين عملك مع مرور الوقت تحياتي zaWorksDate2007.rar

السلام عليكم هذا العمل كبير جدا يحتاج الكثير من الوقت والجهد نبدأ على بركة الله الملاحظات الاولى: 1- تمكين وحدات الماكرو بالاكسس لديك 2-ضبط التاريخ بجهاز الحاسوب مهم جدا لاننا سوف نتعامل مع التاريخ دائما 3- تكون الصورة بالجدول كمرفق وليس نص ( سواء كان حفظ الصور داخل قاعدة البيانات ام خارجها ) 4- عمل حقل للمرفقات الاخرى 5- عمل نموذج حتى تكون الصورة اوضح لك بالعمل تحياتي مرفق اظهار عمر الموظف باليوم والشهر والسنة test-1.rar test-1.rar

وتفضل هذه طريقة اخرى لاضافة البيانات من النموذج mySQL = "Select * From table1" Set rst = CurrentDb.OpenRecordset(mySQL) rst.AddNew rst!nem = nem rst!nnumber = nnumber rst!Tele = Tele rst!Amount = Amount rst.Update MsgBox "Done" تحياتي

السلام عليكم أخي الكريم ستجد بالملف المرفق بعض المعادلات المساعدة في الأعمدة من K إلي BP وبيانها كالتالي: السطر الأول باللون الأزرق يعبر عن رقم الشهر العربي في حال يساوي 9 يعني هذا سيوافق رمضان السطر الثاني حساب بفارق 4 شهور حسب الموجود بالخلية G5 وإذا تغيرت المدة في المستقبل ، فقط غير تلك الخلية السطر الثالث يقر التاريخ بعد مراجعة أنه لايكون الشهر رمضان ولا ديسمبر السطر الرابع لابد أن تملؤه كلما قبضت ربحية السهم أو الككوبون ويمكنك من كتابة شيء إلا "نعم" أو "لا" *** إذا ذهبت بالماوس لليمين ستجد أن التاريخ 11/02/2027 سيوافق رمضان وبالتلي ستجد السطر السفلي يتعدل أوتوماتيكيا وكذلك التاريخ 11/11/2035 سيوافق رمضان وبالتلي ستجد السطر السفلي يتعدل أوتوماتيكيا وكذلك التاريخ 11/12/2036 سيوافق ديسمبر وبالتلي ستجد السطر السفلي يتعدل أوتوماتيكيا وأخيرا الخلية التي بها التنبيه ، جعلت لون الفونط أبيض لكي لا يظهر إلا إذا كان باقي علي الموعد يوم أو تجاوزه ولم تعلم عليه ب "نعم" ، سيظهر باللون الأحمر تستطيع تغيير محتوي خلية ناريخ اليوم (E2) يدويا كأنه يوم واحد قبل الإستحقاق لتري النتيجة ثم تعيدها مرة أخري تفضل وأخبرني الاسهم.xls

اولاً عملية دمج الخلايا غير محببة في الاكسل (خاصة اذا كان هناك معادلات) تم الغاء الدمج ثانياً جرب هذا الملف Elecrique Facture .xlsm

لدي ثلاث جداول taazez للتمويل ورأس المال sdad تسديد الدفعات المطلوبة karzلمنح القروض اريد في الاستعلام ظهور الرصيد التراكمي بعد كل عملية بحيث تكون هكذا : دائن جدول التعزيز + دائن جدول السداد _ مدين جدول القرض = الرصيد التراكمي المتبقي عملت استعلام باضافة ثلاث جدوال اعلاه ولكن لاأدري هل بناء القاعدة والعلاقات صحيح قروض استعلام.accdb

السلام عليكم طريقة استدعاء الوحدة النمطية في التموذج او الاستعلامات سهل جدا / فقط اكتبي اسم الوحدة النمطية او تضعي قبل اسمها call في الوحدة النمطية (Age Calculation) ثلاث دوال الدالة الاولى: خاصة بحساب السنوات /اسمها / CalcAgeY الدالة الثانية: خاصة بحساب الاشهر / اسمها / CalcAgeM الدالة الثالثة: خاصة بحساب الايام/ اسمها / CalcAgeD انظري للصور المرفقة بالشرح حيث تم استدعاء دالة السنة والشهر فقط من خلال الاستعلام الذي اسمه (استعلام خساب العمر) وكذلك تم التعديل على الملف المرفق كما تريدين معرفة العمر بالسنوات والشهر وتم عمله بالاستعلام تحياتي اتمنى الشرح يكون واضح لك test-3.rar

تستطيع ان تلغي حقل اليوم انا وضعت وحدة نمطية لحساب التاريخ للاستفادة منها في كل قاعدة البيانات ولتجنب التكرار تحياتي test-2.rar هذا الملف بعد التعديل الاخير سنة وشهر فقط test-3.rar

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

وهذا زر طباعة الفورم على ورقة A4 القاعدة.xlsm

برنامج جميل الله يعطيك العافية

جرب البحث ورد علي ولكن ادخل بعض البيانات في شيت DATAاولا القاعدة.xlsm

تفضل

احذف هذا السطر من الكود و ترى كل شيء كما تريد Cells(2, "F").Resize(.Count - 1) = _ Application.Transpose(.Items)

بارك الله فيك وجزاك الله خير الثواب

ارفق لكم الملف التالي في هذا الملف يقوم اولا بترحيل البيانات من SHEET الجدول الى باقي الشيتات الاخرى في SHEET " SH3" يوجد فيه صفحتين للطباعة المطلوب كود ليقوم بطباعة الصفحتين على صفحة واحدة ( من الامام والثانية من الخلف لنفس الصفحة( شاكر لكم تعاونكم طباعة الشهادات جديد - Copy.xlsm

ممكن نسخه 2010

جزيت خيرا

وعليكم السلام ورحمة الله وبركاته يوجد كود واحد فقط DoCmd.SetWarnings False DoCmd.RunSQL "insert into table1 (nem,nnumber,tele,amount) values (nem,nnumber,tele,amount)" DoCmd.SetWarnings True اين الكود الثاني ليتم مراجعته تحياتي

اخى على الروابط من سنه 2003 وانظر الى المثال الذى فى مشاركه الاستاذ امير فى نفس الرابط هذا https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=424 بالتوفيق اخى

تفضل ..... تصفية بالعمر.rar

استاذنا الفاضل سليم حاصبيا نرجو منك ان تشرح لنا هذا الكود وهو احدى ابداعاتك لكى نتعلم منك نفعك الله بهذا العلم وجعله من العلم الذى تنتفع به يا اخى Option Explicit Sub Add_sheet() Dim myname As Worksheet Dim P As Worksheet Dim sh_n%, k%, i% Set P = Sheets("اليوميه") sh_n = Application.CountA(P.Range("B:B")) - 1 Dim x%, t%: t = 2 Dim mn$ Application.ScreenUpdating = False ''''''''''''''''''''''''''''''''''''''''' For i = 2 To sh_n On Error Resume Next mn = Sheets(P.Range("b" & i) & "").Name x = Len(mn) If x = 0 Then P.Copy after:=Sheets(Sheets.Count) With ActiveSheet .Name = P.Range("b" & i) .Range("G14") = P.Range("F" & i) .Range("a1").CurrentRegion.Offset(1).ClearContents .Range("A:A").NumberFormat = ("dd- mm-yyy") For k = 2 To sh_n + 1 If P.Range("b" & k) = ActiveSheet.Name Then ActiveSheet.Cells(t, 1).Resize(, 4).Value = _ P.Range("A" & k).Resize(, 4).Value t = t + 1 End If Next End With '========================================= Else Set myname = Sheets(P.Range("b" & i) & "") myname.Range("a1").CurrentRegion.Offset(1).ClearContents For k = 2 To sh_n + 1 If P.Range("b" & k) = myname.Name Then myname.Cells(t, 1).Resize(, 4).Value = _ P.Range("A" & k).Resize(, 4).Value t = t + 1 End If Next '''''''''''''''''''''''''''''''''''' End If mn = "" Err.Number = 0 t = 2 Next i P.Select Application.ScreenUpdating = True End Sub tarhil_by_names.xlsm

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

العذر مقبول اليك الملف Creasy_data_val_1.xlsx

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

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

تفضل التعديل اخي العزيز Root13.rar

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

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

عليك بهذه المعادلة =IF(NOT(ISNUMBER(A2)),"",CHOOSE((MOD(A2,1)<0.5)+1,CEILING(A2,0.5),FLOOR(A2,0.5))) الملف مرفق Question.xlsx

فورم تشغيل ملف صوتى للقران الكريم الفيديو

تفضل أخي الملف به حتي 9 ملفات وليس 5 فقط المعادلات في العمود AB باللون الأحمر تحدد مكان الملف الرئيسي والذي يجب أن تكون الملفات الفرعية بنفس المجلد (الفولدر) العمودان Z,AA باللون الأزرق يمكنك نعديل أسماء الملفات بها الأعمدة المخفية بين G & Z باللون الأصفر بها معادلات تعتمد علي أن الملفات الفرعية مفتوحة أرجو أن يكون هذا هو المطلوب ABC.xlsx E.xlsx D.xlsx C.xlsx B.xlsx A.xlsx

بارك الله فيك رائع

بارك الله فيك وجزاك الله كل خير

الحل 1.xlsx

وعليكم السلام-لا يمكن هذا الا بهذه المعادلة =IF(OR(TRUNC(A60-R60,2)-TRUNC(A60-R60,1)>=0.05,TRUNC(A60-R60,-1)-TRUNC(A60-R60,0)>=0.5),TRUNC(A60-R60,0)+1,TRUNC(A60-R60,0)) abc1.xlsx

جرب هذا الملف My_Book.xlsx

لنلق نظرة على مثال بسيط جدًا لإنشاء Class Alt+F11 Insert Module Class Module يظهر لنا محرر Visual Basic قبل البدء بكتابة الكود يفضل ان نثبت إسم للوحدة النمطية و ليكن clsCustomer في المحرر نكتب ' Class name: clsCustomer Public Name As String قم بحفظ الاجراءات و اخرج من الوحدة النمطية و لنقم مثلاً بانشاء نموذج جديد و نفتح عرض التصميم ، و في محرر Visual Basic نضع الروتين التالي Private Sub sfPrint() End Sub حيث نقوم بتعريف اسم زيون جديد حسب المعرف في clsCustomer باستخدام العبارة ، و هي اساسية لتعريف الزبون الجديد Dim oCustomer As New clsCustomer ثم نستخدم خاصية الاسم name. لهذا الزبون الجديد و نسند له القيمة ' Set the customer name oCustomer.Name = "Nart Lebzo" ثم نحدد الاجراء المراد تطبيقه ' MsgBox the name MsgBox oCustomer.Name و بذلك يصبح الكود كما يلي Private Sub sfPrint() ' Create the object from the class module Dim oCustomer As New clsCustomer ' Set the customer name oCustomer.Name = "Nart Lebzo" ' MsgBox the name MsgBox oCustomer.Name End Sub ثم نقوم ( مثلا ) بانشاء زر أمر نضع خلف حدث النقر الكود التالي لاستدعاء الروتين الذي يطبق clsCustomer Private Sub Command0_Click() Call sfPrint End Sub و للحديث بقية ......

اخوتي الفضلاء في اللغات البرمجية مثل # C و Java ، يتم استخدام Class لإنشاء الكائنات ، و لها مرادف في VBA في Access ، هناك نوعان من الوحدات النمطية : الوحدات النمطية القياسية والوحدات النمطية للفئة Standard modules and class modules موضوع حديثنا هنا والوحدات النمطية للفئة Class ، و هي مصنع الكائنات و خصائصها ، لذا لا بد لنا ان نعرج قليلا على أهم مفاهيم الكائنات في Visual Basic . الكائن هو مزيج من الكودات و البيانات التي يمكن التعامل معها كوحدة واحدة ، و يمكن أن يكون الكائن جزءًا من التطبيق ، مثل عنصر تحكم أو نموذج ، ويمكن أن يكون التطبيق بأكمله كائنًا . عند إنشاء تطبيق في Visual Basic ، تعمل باستمرار مع الكائنات ، و الغالب فيها هي الكائنات التي يوفرها Visual Basic ، مثل عناصر التحكم والنماذج وكائنات الوصول إلى البيانات. Dim db As DAO.Database Dim qd As QueryDef Dim ctl As Control Dim pag As Page كما يمكنك أيضًا استخدام الكائنات من التطبيقات الأخرى داخل تطبيق Visual Basic. Dim ExcelSheet As Object Set ExcelSheet = CreateObject("Excel.Sheet") و الذي يهمنا هنا انه يمكنك أيضًا إنشاء كائناتك الخاصة وتحديد خصائصها و طرق عملها ، و تكون هذه الكائنات مثل اللبنات الجاهزة للبرامج - فهي تتيح لك كتابة الكود مرة واحدة وإعادة استخدامها مرارًا وتكرارًا عند الحاجة لها . و كأي شيئ آخر هناك حسنات و معيقات لاستخدام الكائنات الخاصة في التطبيقات ، ومن الحسنات ، إتاحة بناء التطبيق ككتل معتمدة على الكائنات التي يتم انشاؤها ، ويكون من السهل فحص و اختبار أجزاء التطبيق ، و اذا اضطررنا ( كما يحدث غالبا ) لتعديل او تحديث الكود ، تجنبنا حدوث مشكلات في أجزاء أخرى من التطبيق ، و يبقى دائما من السهل إضافة كائنات بين التطبيقات . أما المعيقات فتتمثل في الجهد والوقت الأطول ( في البداية ) لإنشاء التطبيقات و خاصة عند التحليل و التخطيط ، ولكن على المدى الطويل سيكون هناك توفير للوقت بالاضافة الى كودات يسهل التعامل معها و تحديثها و تعديلها ، كما أنه ليس من السهل دائمًا تحديد ماهية الكائن و خصائصه ، كما أن معظم المبرمجين ( و خاصة الجدد منهم ) يجدون صعوبة ( في البداية ) بفهم الكائنات و الوحدات النمطية للفئة Class . وللحديث بقية ...

الفرق بين ByVal و ByRef Byval يقصد بها الاستدعاء بالقيمة ByRef يقصد بها الاستدعاء بالمرجع الكود التالي سيوضح الفكرة أكثر لنفرض لدينا عددين و نريد تطبيق كود معين او معادلة ما على هذين العددين 'نضع هذا الكود خلف زر امر في نموذج dim x as intger dim y as intger dim i as intger x=10 y=5 'استدعاء كود الجمع بالقيمة و اظهار الناتج i=add1(x,y) msgbox i msgbox x 'استدعاء كود الجمع بالمرجع و اظهار الناتج i=add2(x,y) msgbox i msgbox x 'كود الجمع باستخدام Byval private function add1(byval n1, byval n2) as intger add1=n1+n2 n1=3 end function 'كود الجمع باستخدام ByRef private function add2(byref n1, byref n2) as intger add2=n1+n2 n1=3 end function الشرح في المثال انشئت وظيفة بسيطة لجمع عددين هما X Y عرفت متغيرين و وضعت قيم فيها وهي (x=10) و (y=5) الوظيفة Add1 انشئت وظيفة اسمها Add1 تستقبل عددين هما n1 و n2 ( بالقيمة ) Byval تقوم الوظيفة بجمع العددين و ارجاع الناتج ( و هنا الناتج 15 ) من خلال هذا السطر add1=n1+n2 ثم غيرت قيمة العدد الاول من 10 الى 3 من خلال هذا الكود n1=3 هذا يعني ان x يجب ان تصبح قيمتها 3 ولكن ستجد ان قيمة X مازالت 10 !!!!!!!!!!!!!!!! ( لاحظ انه بعد تعديل قيمة X من الوظيفة وضعت رسالة لتعطي قيمة x ) الوظيفة Add2 الوظيفة Add2 في نفس الوظيفة Add1 لكن الفرق ان الوظيفة Add2 تستقبل القيم n1 و n2 ( بالمرجع ) ByRef تقوم الوظيفة بجمع العددين و ارجاع الناتج ثم غيرت قيمة العدد الاول من 10 الى 3 ولكن هنا ستجد ان قيمة X اصبحت 3 !!!!!!!!!!!!!!!! السبب ان Byval تحافظ على القيمة الاصلية للمتغير المرسل لها اما Byref فهي تغير القيم للمتغير المرسل لها ارجو ان اكون قد وفقت في الشرح

الفرق بين Class و module الوحدة النمطية يخزن بها كود يستدعى من اي مكان في قاعدة البيانات وهو يخفف من كتابة الكود و تسهيل تطوير قاعدة البيانات في المثال السابق عندما عرفنا الوظيفة AdNum وهي تقوم بجمع عددين لنفرض انه لدينا 10 نماذج و نحن بحاجة لتطبيق كود الجمع في جميع هذه النماذج من غير المنطقي تكرار كتابة الوظيفة في كل نموذج اي اننا سنكتب الكود السابق 10 مرات و اذا اردنا ان نعدل او نطور الكود ستكون العملية صعبة و مملة و قابلة للخطا لذلك ننشئ وحدة نمطية ونضع الكود داخلها و بذلك يمكن استدعاء الكود من اي مكان class الكلاس هي تقريبا نفس الوحدة النمطية و لكن يوجد بعض الفروق الاساسية بينهما يتم التعامل مع الوحدة النطية باسم الكود المكتوب ضمنها مثال لنفرض لدينا وحدة نمطية اسمها Mod1 وبداخلها عشرة اكواد code 1 code 2 code 3 وهكذا و انا بحاجة الى استخدام الكود الاول في النموذج اقوم باستدعائه بهذا الشكل call code1 اما الكلاس فالموضوع يختلف لنفرض لدينا كلاس اسمها Class1 و بها عشرة اكواد code1 code2 code3 الخ وانا اريد استخدام الكود الثاني لا يمكن ابدا كتابة الاستدعاء هكذا Call Code2 السبب لانه عليك تعريف متغير يحتوي على الكلاس اولا ثم استخدامه ويتم تعريفها بهذا الشكل dim Cl = new class1 cl.code2 يتبع

اهلا بك اخي الكريم private تعني خاص مثال private sub total في السطر السابق قمت بتعريف كود على انه خاص اي ان هذا الكود يستدعى و يعمل ضمن النموذج المكتوب فيه الكود و اذا حاولت استدعائه من غير نموذج لن يجدي ذلك نفعا public تعني عام مثال public sub total في السطر السابق قمت بتعريف كود على انه كود عام اي انك اذا وضعت الكود السابق في نموذج فيمكنك استدعائه من نموذج آخر دون الحاجة لكتابة الكود مرة اخرى global تعني عالمي Global Strcod as String في السطر السابق تم تعريف متغير من نوع نص على انه عالمي و المقصود هنا ان المتغير يمكن استخدامه في اي مكان من قاعدة البيانات مع ملاحظة انه يمكنك ايضا تعريف المتغيرات بكلمة Public Public Strcod as String لكن عندما تريد استخدام المتغيرات لكافة النماذج يجب عليك وضعها ضمن وحدة نمطية كلمة ( Global ) هي كلمة قديمة و حاليا يحل محلها كلمة ( Public ) dim كلمة يقصد بها تعريف متغير Dim ii as Intger في السطر السابق تم تعريف المتغير ii على انه متغير من نوع رقمي set وتعني ضبط dim db as dao.database set db=currentdb في الكود السابق dim ii as intger المتغير في هذه الحالة يملك قيمة افتراضية وهي 0 اما في السطر السابق قمت بتعريف المتغير Db كقاعدة بيانات و لكنه مازال بحاجة الى تعريف قاعدة البيانات التي عرفته بها لذلك تستخدم كلمة Set و في هذا المثال ضبطت المتغير على قاعدة البيانات الحالية يتبع الفرق بين Sub و Function sub تعني موضوع او كود في في هذه الحالة الكود ينفذ دون ارجاع قيمة مثال public sub Amsg msgbox "aa" end sub عرفت الكود ليعطي رسالة مكتوب فيها aa و يستدعى بهذا الشكل call Amsg لاحظ هنا ان الكود لا يعيد قيمة هو فقط يعطي رسالة اما Function فهي وظيفة و هي تعيد قيمة مثال Public Function AdNum (ii as intger,ss as intger) as intger adnum=ii+ss end function في هذا المثال عرفت الوظيفة لتقوم بجمع عددين وتعطي الناتج حيث يمثل Adnum اسم الوظيفة و ii العدد الاول و ss العدد الثاني تستدعى بهذا الشكل call AdNum(10,15) لاحظ هنا ان الوظيفة تعيد قيمة وهي ناتج جمع العددين يتبع

الأخ الكريم الميسانى على الرغم من أن طلبك حيرنى إلا إنى طلعت منه بكود أعتقد أنه جميل وظريف هذا الكود هيخليك تتعلم سواقة العربيات بدرى بدرى لذلك سميته كود الفتيس على غرارعصا الفتيس فى العربيات عملت لك تعديلات وتنسيقات كان لابد منها فى الملف لتحقيق مطلبك اللى صدمنى من أول وهله أشوفه 3 اكواد فى الملف كود عمل pdf Sub PDFusingdialogbox() 'by mokhtar hussien '27/6/2015 Dim Rng As Range Dim i As Variant Dim Fname As String Fname = "" i = Application.GetSaveAsFilename(Fname, "PDF Files (*.pdf), *.pdf") Set Rng = Sheets("ورقة3").Range(Cells(1, 1), Cells(Rows.Count, 8)) Application.ScreenUpdating = False Rng.Activate Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=i, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True Sheets("ورقة3").Range("A1").Select Application.ScreenUpdating = True End Sub كود الفتيس وهو مسؤل عن نقل النطاق المتاح فى الورقة 2 الى الورقة 3 مع كل غيار تاخده بعصا الفتيس ( الـ Spinner ) الـ Spinner هنا أصبح ليه وظيفين تغيير البيانات فى الورقة 2 + يعمل عمل عصا الفتيس وده مش هتلاقيه فى أى حته فى العالم إلا عندنا فى الصعيد Sub Spinner6_Change() 'fetace code 'by mokhtar hussien '27/6/2015 Dim Rng As Range Set Rng = Sheets("ورقة2").Range("A1:H39") Application.ScreenUpdating = False Rng.Copy With ActiveWorkbook.Sheets("ورقة3").Cells(Rows.Count, "A").End(xlUp) .PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub كود مسح البيانات من الورقة 3 اذا أخطأت فى التعامل مع عصا الفيس مش سايبك أنا أهه Sub del() 'by mokhtar hussien '27/6/2015 Application.ScreenUpdating = False Columns("A:H").Select With Selection .ClearContents .Borders.LineStyle = xlNone End With Range("a1").Select Application.ScreenUpdating = True End Sub المرفق used range as pdf using dialog box 2 by mokhtar .rar

اخوانى وأحبابى السلام عليكم اليوم أقدم لكم كيفية عمل صورة من مدى معين تحدده مع حفظ الصورة فى مسار تحدده أيضاً الكود المستخدم فى الموضوع مديول عادى : Sub make_jpeg() Dim i As Integer Dim intCount As Integer Dim objPic As Shape Dim objChart As Chart 'نسخ المدى كصوره Call Sheet1.Range("A1:f13").CopyPicture(xlScreen, xlPicture) 'مسح أى أشكال من شيت 2 intCount = Sheet2.Shapes.Count For i = 1 To intCount Sheet2.Shapes.Item(1).Delete Next i 'عمل جدول فى شيت 2 Sheet2.Shapes.AddChart 'تنشيط شيت 2 Sheet2.Activate 'تحديد الجدول الذى يوجد فى شيت 2 Sheet2.Shapes.Item(1).Select Set objChart = ActiveChart 'لصق المدى اللى نسخناه فى هذا الجدول Sheet2.Shapes.Item(1).Width = Range("A1:f13").Width Sheet2.Shapes.Item(1).Height = Range("A1:f13").Height objChart.Paste 'حفظ الجدول كصورة فى المسار التالى objChart.Export ("D:\photo\mokhtar.Jpeg") End Sub وتفضلوا المرفق واعلموا أن لا أريد كلمات المدح أو الثناء ولكن كل ما أريده من حضراتكم دعوة بسيطة بظهر الغيب للمرحوم أبى . كل سنة وأنتم أقرب الى اللـــــه عز وجل range 2 jpeg by mohtar.rar

ارجو قبول هديتى المتواضعه للمنتدى _ و هو برنامج حسابات و ميزان مراجعه _ اصدار 2 _ بالمعادلات و لا انسى فضل ما تعلمته من اعضاء المنتدى تم استخدام مجموعه من الايكونات المنقولة من المنتدى ارجو ابداء الرأى _ مع طلبى لاعضاء المنتدى عمل فورم بحث عن الحساب عند ادراج قيمة بعمود المدين و الدائن نظرا لتعدد اعمدة الحسابات بالمرفق يومية و ميزان مراجعه امريكى معدل_2013.rar

اخوانى الاعزاء مشرفين واعضاء المنتدى اقدم ايلكم برنامج الاقساط البارع من تصميمى يعمل فى 12 شركه لتقسيط الاجهزه الكهريائيه انه برنامج بسيط وسهل وانا اليوم رفعت نسخه تجربيه من البرنامج وارجو ان تعجبكم البرنامج فى المرفقات user : admin password : 1234 وشكراا