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

استأذن من الجماعة اتفضل اخي يوسف الكود صار هكذ Private Sub endate_AfterUpdate() Dim X, Z As Date X = #1/1/2018# Z = #12/31/2018# If Me.endate > X Or Me.endate < Z Then MsgBox ("التاريخ يجب ان يكون خلال عام2018") endate = Date End If Refresh End Sub 123 (1).accdb

بسم الله الرحمان الرحيم السلام عليكم اصدقائي اعضاء منتدى اوفيسنا تم الانتهاء بحمد لله من قاعدة البيانات تم الاعتماد على الاكسيس كقاعدة البيانات لذى لن يكون هناك اي ثقل او ضغط على الاكسيل فواتير الشراء و فواتير البيع اضافة فاتورة بحث وتعديل او طباعة البحث عن الاصناف باستعمال خاصية النص التنبئي اتبعنا السعر الوسط للاصناف في حال توفر كميات مختلفة باسعار مختلفة في المخزون الاصناف الجديدة تدخل اوتوماتيكيا الى المخزن مباشرة من فاتورة الشراء و كذالك يتم تكويدها اوتوماتيكيا امكانية اضافة القيمة المضافة للفواتير حسب ارادة المستخدم اضهار ان كانت الفاتورة مسددة ام لا و ايضا اضهار ان كان مسدد جزء من الفاتورة و المبلغ المتبقي الموردين و العملاء اضافة بحث وتعديل او حذف اضهار كل الفواتير المتعلقة بالعميل او المود اضهار الفواتير الغير مسددة او الغير مدفوعة للعميل او المورد كشف حساب تفصيلي لكل عميل او مورد طباعة كشف الحساب اضهار عدد الفواتير المتعلقة بكل عميل او مورد و اضهار مجموع المبالغ المدفوعة او المسددة و مجموع المبالغ المستحقة المخزون قائمة كل الاصناف مع امكانية التعديل على اسم الصنف اضهار قائمة بالاصناف القريبة النفاذ وذلك على حسب كمية يحددها المستخدم اضهار قائمة الاصناف التي نفذت من المخزون قائمة بكل عمليات الشراء الخاصة بكل صنف قائمة بكل عمليات البيع الخاصة بكل صنف صافي ربح الصنف امكانية استراد قائمة اصناف من ملف اكسل خارجي جاري العمل عللى مكانية استراد الاصناف من صيغ اخرى كالاكسيس او الملفات النصية سندات الصرف و سندات القبض اضافة بحث وتعديل او حذف + طباعة السندات بحث بواسطة رقم السند او رقم الفاتورة او اسم العميل او المورد او بين فترة زمنية معينة اثناء اضافو السندات سواء قبض او صرف لا تضهر الى الفواتير الغير مسددة عند اختيار الفاتورة يضهر مبلغها اوتوماتيكيا امكانية اختيار طريقة الدفع نقدا او شيك مضهر البرنامج امكانية تغير ثيم البرنامج امكانية تغير لغة البرنامج (عربية انجليزة و فرنسية) يعتمد البرنامج على واجهة الاكسل الرئيسة و اليوزرفورم معا معلومات اخرى امكانية رفع قاعدة بيانات البرنامج على سيرفر محلي او عام (لاخوف على قاعدة البيانات في حال سقوط الونداوز) امكانية العمل على البرنامج من طرف اكثر من مستخدم في وقت واحد هذه بعض الصور المسربة للبرنامج هذا ماتم انجازه بفضل الله الى حد الساعة لذى احتاج من كل الاعضاء ابداء اقتراحاتهم حول الامور المنجزة و ايضا اعطائنا اي اضافات تودون ان اضيفها للبرنامج لانه لم يعد يتوفر في جعبتي اي افكار لذي ارجو من لهم خبرة في التعامل مع هذا النوع من البرامج ان يبدو اقتراحاتهم او يرةني بعض البرامج التي يمكن ان استمد منها افكار اخرى تحياتي للجميع اخوكم في الله شوقي ربيع

مرفق المثال تغيير القيمة الافتراضية برمجياً.rar

استغفر الله نحن بخدمتكم

السلام عليكم بعد اذنك اخي العزيز ابو ياسين اخي العزيز يوسف هناك اخطاء واضحة في الكود وهي المتغيرين من المفترض ان يكونا من النوع Date و ليس integer جملة if تم اغلاقها بالجملة End If مع انها لا تحتاج الى اغلاق لأن جواب الشرط موجود في نفس السطر بالتوفيق

بارك الله فيك اخي Shivan Rekany وفيت وكيفت تسلم الله يحفظك

اخي ارفق مثال واشرح المطلوب كل واحد وله طريقه حتى تستفيد من طرق اخرى

اتفضل هذا حسب فهمي لطلبك برنامج 0.5 %.rar

لزيادة الفائدة من أجل حساب حجم ملف نغير السطر التالي بالكود الذي وضعه صديقي شفان: بهذا السطر Set f = fs.GetFile(filespec)

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

اتفضل اخي اليك هذا Function FolderSize(filespec) Dim fs, f, s Dim SizeName As String Dim SizeFil As Long Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(filespec) If f.Size >= 1 And f.Size <= 1023 Then SizeName = " Byte " SizeFil = f.Size ElseIf f.Size >= 1024 And f.Size <= 1048575 Then SizeName = " KB " SizeFil = f.Size / 1024 ElseIf f.Size >= 1048576 And f.Size <= 1073741823 Then SizeName = " MB " SizeFil = f.Size / 1048576 ElseIf f.Size >= 1073741824 And f.Size <= 1099511627775# Then SizeName = " GB " SizeFil = f.Size / 1073741824 ElseIf f.Size >= 1099511627776# Then SizeName = " TB " SizeFil = f.Size / 1099511627776# End If s = UCase(f.Name) & " Size Folder is ( " & SizeFil & " )" & SizeName MsgBox s ', 0, "Folder Size Info" End Function Private Sub Command0_Click() FolderSize ("C:\Users\MyShiv\Downloads") End Sub

ما تفضل به أخي sandanet يحل المشكلة و هذا تعديل على ملفك بطريقة أخرى DBProg8.rar

اتفضل هذا حسب طلبك 123.accdb

السلام عليكم احذف الفرز الموجود بالتقرير كما توضح الصورة التالية:

یعنی حضرتك يريد ان يختار فولدر من الكومبيوتر و يستخرج لك الحجم الفولدر المختارة ؟ اذا نعم حمل المرفق الاخير بها ما تريد واذا لا ... اذا تشرح لي اكثر سنكون من الشاكرين تحياتي

الله يعلى قدرك ويرفع شأنك يارب بص يا استاذى الكريم انا من قبل فترة وجدت هذا الكود Sub FolderSize() Dim fso As Object, fsoFolder As Object Const strFolderName = "D:\xxx" Set fso = CreateObject("Scripting.FileSystemObject") Set fsoFolder = fso.GetFolder(strFolderName) MsgBox fsoFolder.Size & " bytes" Set fsoFolder = Nothing Set fso = Nothing End Sub -------- Private Sub Command0_Click() Call FolderSize End Sub كان له وقتها مشكله معى وهى التحويل من البايت للكيلو والميجا والقيقا بصراحة مش عارفهم ومحبش الحسابات ههههههه لما اليوم حاولت ارد على اختنا الكريمة صاحبة السؤال هى بصراحة عملت مرونة فى التصميم حاولت اغير الكود فى السطر ده Const strFolderName = "D:\xxx" لاستبدل المسار الثابت فى الكود D:\xxx بالمسار المحدد فى مربع النص من النموذج وللاسف لم استطع عمل ذلك وهذا محور سؤالى فكيف السبيل الى ذلك طبعا اولا واخيرا حضرتك ما شاء الله كفيت ووفيت ولكن انا اسال من باب العلم اخى الكريم فى المعضلة التى تعرضت انا لها

اتفضل استاذ الحبيب نحن في خدمتك

استاذ @Shivan Rekany اولا تسلم ايدك ممكن اتقل على حضرتك بسؤال فى نفس سياق الموضوع لو تكرمت

نعم لكن حسب كنا نريد ان يظهر الحجم بالضبط ... واذا صاحب السؤال يريد ذلك نقدر ان نستخدمه

راااااااااااااااااااائع استاذ شيفان انا جربت وطلع لى الرقم كده 109.062536341138 GB والمساحة للمجلد ده عندى فعلا 109 قيقا طبعا ممكن نستخدم الدالة روند للتقريب للو اردنا صح ؟ واللا ايه رأى حضرتك

اعتذر من الجماعة كان خطأ في الكود وهو بدل ان استخدم اشارة تقسيم "/" انا استخدمت هذا "\" اتفضل اخي التعديل على القاعدة وتم تعديل على كود في مشاركتي الاولى Folder Size.mdb

السلام عليكم يمكن فعل ذلك بطريقتين (حسب رأيي): * الطريقة الأولى : باستعمال "تنسيق الخلية"، في ملفك اخترتَ التنسيق "النسبة ...... %0" قم بتخصيصه بإضافة فاصلتين منقوطتين بعد رمز % بمعنى أن يكون بالشكل هذا التنسيق من الشكل ";;%0" (دون علامات التنصيص).. * الطريقة الثانية : إضافة (مثلا) الدالة الشرطية IF لمعادلتك وعلى سبيل المثال أن تكون المعادلة في الخلية G6 بالشكل التالي: =IFERROR(IF(F6/F$5=0;"";F6/F$5);"") أو من الشكل =IFERROR(IF(OR(F6=0;F6="");"";F6/F$5);"") أما إذا كنت تريد أن تكون خلية النسبة خالية فقط عندما تكون "خلية المقسوم" خالية فالحل يكون بالمعادلات: وكتطبيق على الخلية G6 تكون المعادلة بالشكل التالي: =IFERROR(IF(F6="";"";F6/F$5);"") والله أعلم

قم بتغيير كافة اسماء Lebel من خلال Properties الى LB2 LB1 ,وهكذا اذ ربما يكون Lebel1 او Lebe2 غير موجود حقيقة( تم ادراجه ثم مسحه) الملف مرفق Book1 salim.rar

ممکن تعطينا مثال على ماتريد بالضبط وتخبرنا بالشروط لكي نفكر اكثر بطريقة سليمة

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

تفضل استاذ ابو ياسين 123.accdb فعلا استاذ يوسف عندما غيرت المتغيرين الي DATE وازلت ENDIF الكود يعمل بصورة صحيحية عدا انه لايظهر الرسالة

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

ريما يكون هذا الكود هو المطلوب Private Sub UserForm_Initialize() Dim K%: K = Sheets("ورقة1").Cells(6, Columns.Count).End(1).Column Dim i% On Error Resume Next For i = 1 To K Me.Controls("Lb" & i).Caption = Cells(6, i).Value Next i End Sub

انظر الي هذه المواضيع https://www.officena.net/ib/topic/51244-لاول-مره-على-الانترنت-كتاب-تعلم-لغه-ال-vba-باللغه-العربيه-إكسيل/ https://www.officena.net/ib/topic/17922-شرح-الفيجوال-بيزيك-للمتوسطين/ https://www.officena.net/ib/topic/66829-اريد-أن-أتعلم-لغة-برمجة-vba-المستخدمة-في-اكسل/ https://www.officena.net/ib/topic/49980-اضخم-كتاب-لتعلم-الصيغ-والدوال-في-excel-2007/ https://www.officena.net/ib/topic/37284-هنا-قاعدة-بيانات-اكواد-vba-للاكسل-مع-الشرح-والامثلة-مرجع-للجميع/

جرب هذا الكود امكانية المعاينة قبل الطباعة ثم اختيار طباعة عمل الكود:- 1- تغير التنسيق (حجم الخط ونوعه) ويمكن لك تغيرهم في الكود نفسه 2-معاينة الطباعة 3- اختيار الطباعة 4- ارجاع تنسيق (حجم الخط ) الى ماكان عليه قبل تنفيذ الكود طباعة-تغيرالتنسيق - ارجاع التنسيق السابق.xlsm

انظر الملف Book1.rar

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

جرب هذا االملف الكود Sub crazy_sum() Dim arr() Dim i% For i = 1 To Sheets.Count ReDim Preserve arr(1 To i) arr(i) = Sheets(i).Name Next On Error Resume Next With Sheets("Sheet1") .Range("a1") = IIf(IsError(Application.Match(CStr(.Range("a2") + _ .Range("a3")), arr, 0)), Evaluate("=sum(a2:a3)"), vbNullString) End With End Sub الملف مرفق Crezy_Book.xlsm

اتفضل Sort3.rar

اجعل تنسيق Avrg رقم عام واجعل المنازل العشرية تلقائي

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

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

شكرا لكم احبتي على مروركم وتفاعلكم .. وكل ما تفضلتم به أعلمه ولكن لعل ما امتنع بالامس يتحقق اليوم

السلام عليكم ورحمة الله تعالى وبركاته شكرا لك على هده المقدمة النابعة من صدقكم وحرصكم على استمرار هدا المنتدى التعليمي الدي اعطى الكثير وافاد الكثير دون نكران للجميل ونتمنى لاساتدتنا الفضلاء دوام الصحة ونعمة مما قدموه لنا من نصح وارشاد في ما يخص برمجة الاكسس بدون كلل او ملل ( والله في عون العبد مادام العبد في عون اخيه ) عندي اقتراح بسيط وهو عدم تعديل على الامثلة المرفقة من السائل وانما شرح لسائل الطريقة بالصور لتعليم فاني ارى هده الفكرة تعليمية و ستزيد من رواد المنتدى لان الشرح يصبح ملموسا { كمــــا قيل علمنـــي ولا تعطينـــي } فهدا مجرد رأي والسلام ختام وتمنياتنا بالاستمرار والنجاح

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

السلام عليكم و رحمة الله وبركاته اخي الفاضل كما فهمت ان المطلوب التخلص من الدوال و استبدالها بقيم للنطاق الظاهر امامك على الشاشة بعد عمل التصفية ولا يتم استبدا الدوال للصفوف المخفية مع التصفية جرب هذا الكود Sub az1() ' ' 16/02/2018 AZ ' Dim RN As Range Range("$A$2:$U$9").AutoFilter Field:=1, Criteria1:=">0" Range("A2:U9").SpecialCells(xlCellTypeVisible).Select For Each RN In Selection If RN.HasFormula = True Then RN = RN.Value End If Next End Sub

لغير متابعي موضوع ( VLOOKUP ) من البداية حتى الاحتراف حيث تعرضنا فية للدالة INDIRECT شرح الدالة INDIRECT INDIRECT.rar ........................................................... اتمنى ان يمثل الملف إضافة بسيطة