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

السلام عليكم ورحمة الله وبركاته .. وبدون مقدمات 🙂 يطيب لي أن أضع بين يديكم برنامج ( مكتبة الأكواد الخاصة ) كان الهدف من تصميم البرنامج أن يخدمني بشكل خاص وذلك لحفظ الأكواد التي أحتاجها بشكل دائم وتجميعها في مكان واحد وتسهيل عملية البحث والوصول إليها بكل سهولة .. والبرنامج به تجميعة طيبة من الأكواد بعضها مما أبدعه الشباب هنا وبعضها مما صنعتها بنفسي ومنها من مواقع مختلفة .. والآن أحببت أن أشارككم بها وأن تعم الفائدة للجميع 🙂 البرنامج طبعا مفتوح بأحلاسه وأقلاسه ( بنماذجه وأكواده ) 😁 ويوجد فيه خاصية البحث ، وإدراج مرفقات (خارجية طبعا ) ومتاح للتطوير والتعديل والزيادة وتطويعه حسب احتياجاتكم .. 🌹 :: ولا تنسوني من صالح دعواتكم :: Pleeeeeeeeeeeeeeese 😄🤲🌷🌹 (واجهة البرنامج) (نافذة تفاصيل الكود) أعتقد البرنامج ما محتاج شرح واضح وضوح الشمس 😁 ::والتحميل في المرفقات :: مكتبة الأكواد الخاصة.accdb

السلام عليكم , الأخوة الكرام فى بعض الاحيان قد تحتاج الى عمل آلية لتنفيذ اوامر بخطوات ذات ترتيب محدد , وقد تحتاج الى الزام المستخدم باتباع هذه الخطوات .. طبعاً الطرق كثيرة واليوم لدينا طريقة المعالج Wizard فكرة بسيطة كالتالى : تعتمد الطريقة على نموذج متعدد الصفحات Tab Control والتنقل الى صفحات معينة بالكود , الطريقة يمكن استخدامها لأهداف كثيرة قد تستخدمها كمعالج اعداد لبرنامجك لأول مرة وقد تستخدمها فى شرح آلية عمل برنامجك بطريقة مصورة مثلا الخ ... المثال به ثلاث صفحات ويمكن زيادتها كما تريد ولكن يلزم ترتيبها وذلك حتى اذا ضغطت على Next او Back يلتزم بالترتيب المطلوب اولا اذا اردت اضافة صفحة اضغط على Tab Control بالزر الأيمن للماوس ثم Insert Page .. ثم لتعديل الترتيب كما تريد دمتم سالمين ت Wizard With Steps.accdb

السلام عليكم 🙂 يتشرف منتدى الاكسس بالنيابة عن موقع اوفسينا وجميع الاعضاء ، ان نزف رتبة خبير الى الاخ موسى @Moosak ، والذي ذاع صيته كخبير من مشاركاته 🙂 اتمنى لك اخوي موسى دوام التقدم ، ولا تمد رجولك قد لحافك ، فلا تقبل بالارتقاء غير النجوم بدلا 🙂 جعفر

ما شاء الله تبارك الله .. كنت حاس أنه فيه طبخة تنعمل في الكواليس 😂 من يوم الأستاذ جعفر يناديني أخي الخبير 😅 بصراحة متفاجئ من الموضوع .. وكان يكفيني لقب شغوف .. لأنه فعلا يعبر عن شعوري 😄 الحقيقة أشكر لكم جميعاً هذا الوسام وحسن الضن وعلى قمة الهرم أساتذتي الأعزاء ( الخبراء الفعليين ) الأستاذ جعفر @jjafferr الدكتور @محمد طاهر الأستاذ @ابو جودي وجميع السادة الأساتذة الأجلاء فردا فردا .. ممن لازلت أنهل من معينهم وأتعلم من خبراتهم ولا ننكر فضلهم علينا .. 🌺🌹🌷 ويكفيني شرفاً خدمتكم بما يمن الله به .. وأن أزاحمكم بالركب في هذا الصرح الشامخ .. ☺️🌹 ودمتم سالمين ✋🏻

فقط استبدل Cells(6, 7).Resize(.Count, UBound(A, 2)) = Application.Index(.items, 0, 0) بالسطر Sheets("Sheet2").Cells(1, 1).Resize(.Count, UBound(A, 2)) = Application.Index(.items, 0, 0)

أتمنى لك المزيد من التألق ، وأتطلع إلى إبداعاتك دائما

Sub Test() Dim a, ws As Worksheet, rng As Range, m As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(1) m = ws.Cells(Rows.Count, "B").End(xlUp).Row Set rng = ws.Range("B3:B" & m) rng.Offset(, 1).Formula = "=kh_Names($B3,1,2)" rng.Offset(, 2).Formula = "=kh_Names($B3,1,2,3)" rng.Offset(, 3).Formula = "=kh_Names($B3,1,2,3,4)" rng.Offset(, 4).Formula = "=IF(COUNTIF($C$3:$C$" & m & ",C3)>1,COUNTIF($C$3:$C$" & m & ",C3),C3)" rng.Offset(, 5).Formula = "=IFERROR(IF(VALUE(F3)>1,IF(COUNTIF($D$3:$D$" & m & ",D3)>1,COUNTIF($D$3:$D$" & m & ",D3),D3),""""),"""")" rng.Offset(, 6).Formula = "=IFERROR(IF(VALUE(G3)>1,IF(COUNTIF($E$3:$E$" & m & ",E3)>1,COUNTIF($E$3:$E$" & m & ",E3),E3),""""),"""")" With rng.Offset(, 7) .Formula = "=CONCATENATE(IF(AND(ISTEXT(F3),F3<>""""),F3,""""),IF(AND(ISTEXT(G3),G3<>""""),G3,""""),IF(AND(ISTEXT(H3),H3<>""""),H3,""""))" a = .Value rng.Offset(, 1).Value = a End With ws.Columns("D:I").ClearContents Application.ScreenUpdating = True End Sub

اعرض الملف برنامج ::🎁 📚(( مكتبة الأكواد الخاصة ))📚🎁 :: بسم الله الرحمن الرحيم أضع بين أيديكم برنامج :: (( مكتبة الأكواد الخاصة )) :: وهو عبارة عن حافظة شخصية للأكواد والملفات الخاصة بمبرمج الأكسس أو أي مبرمج آخر .. البرنامج به كم لا بأس به من الأكواد التي كنت أستخدمها في تصميم البرامج، بعضها من إبداعات الإخوة في الموقع وبعضها من مصادر أخرى.. من مميزات البرنامج خاصية البحث السريع للوصول للأكواد بسهولة .. وفيه تقسيمات للأكواد المجربة وغير المجربة .. وكذلك يمكن الإشارة للمرجع الذي تم أخذ الأكواد منه .. وأيضا يمكن حفظ الملفات المرتبطة والأمثلة في مجلدات قرينة بالبرنامج 🙂 البرنامج مفتوح المصدر ويمكن لك أن تغير فيه ما تشاء ليلبي احتياجاتك الشخصية .. 🌷 :: تحياتي :: 🌷 🙂 :: ولا تنسوني من صالح دعواتكم :: 🙂 صاحب الملف Moosak تمت الاضافه 15 مار, 2022 الاقسام قسم الأكسيس  

السلام عليكم ورحمة الله وبركاته وبعد وبناءا علي طلب الأستاذ @أبو إبراهيم الغامدي حفظه الله بافراد استفساري بموضوع مستقل هنا وقد تفضل سيادته مشكورا بوضع مرفق لما اردت ولكن ولكوني لا زلت اجهل العمل بلغة الـ html الا يسيرا وكذلك لتعم الفائدة بطلب شرح لآلية العمل بالمرفق فاسأبدأ استفساراتي حول مرفق الاستاذ من خلال النقطتين التاليتين: 1- في المرفق تم جلب قيمة الصف من خلال معرفة موضع الـ CheckBox المعلمة وسأحول استقراء الأكود لحين رد احد الاساتذة الأكارم - والسؤال هل يمكن ارسال القيمة للـ CheckBox بدلا من معرفتها؟ وهذا كان سؤالي منذ البداية بالموضوع السابق الاشارة اليه 2- بالمرفق كود بعد تعليم الـ CheckBox أو عند حدث النقر علي الـ CheckBox ولكن ما عرفت كيف يعمل؟! اما عن المرفق فها هو HTML Table.accdb اما عن مرفقي الذي وضعت به توضيح السؤال فهذا هو TestCheckBox.rar وجزاكم الله خيرا

السلام عليكم ورحمة الله تعالى وبركاته قائمة ديناميكية طى وتوسيع لهواة تصميم واجهات مودرن اترككم مع التجربــة collapse menu.zip

الله يبارك فيك أستاذنا أبو عبدالله .. 🙂 وشكرا على كلماتك الطيبة 🙂

جزاك الله خيرا ومبارك الترقية خبيرا قد شرف بكم اللقب فأنتم أهله وأحق به

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

وعليكم السلام -تفضل هذا الحل بما انك لم تقم برفع الملف الذى يحتوى على الكود الذى به المشكلة .. فإن لم تستطع التطبيق وحل مشكلتك ... فلابد لزاماً من رفع الملف للوقوف على المشكلة والعمل على حلها من قبل الأساتذة وشكرا . Compile error: Constants, ...Declare statements not allowed وهذا كود أخر ... ولكنى لا أعلم هل سيفيد مشكلتك ام لا لأنه لا يمكن العمل على التخمين !!! Option Explicit Dim wb As Workbook Dim Cell, rng As Range Dim A(1 To 4) As String Dim arrData() As Variant Dim arrRow, lRow, lCol As Long Dim i1, i2, j1, j2 As Long 'Public ListGroup() Public Sub ArrayToFinnish() Dim Cell As String Dim aCell As Range A(1) = "Ship Via Description" A(2) = "Speditor" A(3) = "Planned Ship Date/Time" A(4) = "Weight" 'A(4) = "Customer Order" 'A(5) = "Customer Number" Sheet1.Activate lRow = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).row lCol = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column Set rng = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, lCol)) ReDim arrData(1 To lRow, 1 To UBound(A, 1)) 'ListGroup = arrData(1 To lRow, 1 To Ubound(A,1)) For i1 = 2 To lRow For j1 = 1 To UBound(A, 1) Set aCell = rng.Find(A(j1)) Cell = Sheet1.Cells(i1, aCell.Column).Value Select Case Cell Case Cell = "EXPRESS" Case Cell = "TRUCK" Case Cell = "CZ/DACHSER/Axis Communications LLC" Case Cell = "DE/ASH Logistik/Abris" Case Cell = "DE/EXP Cargo/RRC Cent. Asia" Case Cell = "HU/Trans-Gate/IQ Trading" Case Cell = "USA/Atlanta/Splitpoint" Case "AIRFREIGHT" arrRow = arrRow + 1 KN Case Cell = "China/Shanghai/Splitpoint" Case Cell = "Singapore/KN/CDP" Case Cell = "US/Geodis/Miami" Case Cell = "BR/Sao Paulo/Splitpoint" Case Cell = "Japan / Multitek / Warehouse" End Select Next j1 Next i1 End Sub Private Sub KN() Dim ws As Worksheet Dim KCell, KCellD, KCellW As Range 'Dim j3 As Long Dim D As Date Set wb = ThisWorkbook lRow = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).row lCol = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column Set ws = wb.ActiveSheet Set rng = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, lCol)) Set KCellD = rng.Find(A(3)) Set KCellW = rng.Find(A(4)) With ws ' ****** Getting an error here , you are not setting KCell Range ****** D = .Cells(i1, KCell.Column) Select Case D Case DateAdd("d", 1, Date) If .Cells(i1, KCellW.Column).Value >= 50 Then For j2 = 1 To UBound(A, 1) arrData(arrRow, j2) = .Cells(i1, j2).Value Next j2 End If Case DateAdd("d", 2, Date) If .Cells(i1, KCellW.Column).Value >= 1000 Then For j2 = 1 To UBound(A, 1) arrData(arrRow, j2) = .Cells(i1, j2).Value Next j2 End If Case Else ' not sure why need, you are not using it End Select End With End Sub

استاذ محمد حسن ما شاء الله عليك مبدع والابداع عادة من عاداتك الجميله فاعمالك كلها ذات مذاق ورحيق جميل يحمل اسمك دائما شكرا لك ولعطائك المستمر

جميل جدا ما شاء الله .. هذا هو التفكير خارج الصندوق 🙂 تخلينا نعيد التفكير في إعادة تطوير برامجنا السابقة 😅

السلام عليكم حسب فهمي لطلبك تفضل Private Sub Expiry_Date_AfterUpdate() If Date >= Expiry_Date Then Beep MsgBox "لقد تم انتهاء الضمان" Me.Warranty = 0 Me.Expiry_Date = "" Me.Refresh End If End Sub فترة الضمان.accdb

جزاك الله خير ابا جودي، لكن عن نفسي وفي هكذا مشاريع افضل استخدام WebBrowser اختصارا للوقت + لتوفير مساحة الكائنات في النموذج.

مثال جميل جزاكم الله خير @ابو جودي

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

انظر هذه المحاولة اذا تنفع Lab_2.accdb

الف مبروك 👍 استاذ @Moosak ما شاء الله عليه لا يقصر فى تقديم يد العون والمساعدة كما انه له مشاركات متميزة يستحق الترقية الى درجة خبيـر عن جدارة مبروك علينا الرفقة الطيبة ومبروك التشريف والتكليف اهلا بك بين اخوانك بارك الله فيك يا دكتور كل الشكر و التقدير والعرفان لحضرتك يا دكتور@محمد طاهر

الف مبروك 🌼

شغل مرتب ومفيد ... شكرا استاذ موسى

مسألتك سهلة جدا .. كثير من الاعضاء يمكنهم مساعدتك في دقائق ولكن المرفق صعب ومعقد ولا يمكن تصفح برنامجك بسبب الاكواد التي لا حاجة لها في النموذج الرئيس لم اتمكن من فتح النموذج حتى اغلقت معظم الاكواد الموجودة فيه في المرات القادمة حاول ان يكون المرفق بسيطا وحسب الحاجة .. الدائن و المدين-3.rar

عمل جميل .. بارك الله فيك

السلام عليكم أخي الكريم كنت أتمنى أن يكون هناك عملاً أفضل مما سأقدمه لك لكن ريثما يكون ذلك إليك هذا الحل... تنسيق شرطى.xlsm

السلام عليكم ورحمة الله وبركاته استكمالا لسلسلة شرح الجمل الشرطية سنستحدث سلسلة اخرى تتعلق بكيفية استخدام الخلايا في ال vba وكان من المفروض البدء بها قبل شرح الجمل الشرطية لكونها تعتمد عليها في بعض الجوانب وسيتم تناول ثلاثة مواضيع بالتناوب وهي : 1. استخدام جمل ال range 2. استخدام جمل ال cells 3. استخدام جمل ال offset وسنبدأ بالموضوع الاول ...حيث هناك مرفق تم فيه شرح الكيفية في الاستخدام الموضوع باجتهاد شخصي وقد يحتمل الصواب والخطأ وقد يحتمل النسيان فان كنت قد أصبت فالحمد لله وانت كنت قد اخطأت فذلك يعلمني وان كنت قد نسيت فجل من لا ينسى او ان اكون قد اغفلت بعض الجوانب التي لم اضعها في الحسبان وهذه دعوة مفتوحة للجميع بالمشاركة في هذا الموضوع حتى يكون موضوع هادف وكامل ومفيد ان شاء الله اخوكم عماد الحسامي hosami range.rar

السلام عليكم ورحمة الله وبركاته ظهر في الاونة الاخيرة تزايد الاستفسار عن الجمل الشرطية وكيفية استخدامها, ولما لها من الاهمية الكبيرة في الاستخدامات المتعددة والمتكررة حتى يكاد لا يخلو يرنامج من استخدام احدى الدوال الشرطية المتعددة ، وبالنسبة الي اجزم انها اهم جمل ودوال ال vba لذلك سابدا بعمل سلسلة لشرح هذه الدوال والجمل وهذا باب مفتوح لكل من يريد المساهمة في انهاء هذه السلسلة وسنقوم بتداولها بطرق سهلة حتى تتم الفائدة للكل ومهما كان مستوى المشارك . اما الجمل والدوال التي سنتاولها فهي : 1. جملة اذا المشروطة if ... then 2. جملة الانتقال الشرطية if .. then .. else 3.جملة الانتقال الشرطية if .. then .. else المتعددة والمتشابكة 4.جملة التفرغ المتعددة case 5.دالة التحويل switch 6.دالة الاختيار المرتب choose الموضوع ليس معقد واسهل مما تتوقعونه وستلاحظون الامكانات الهائلة لهذ الدوال والجمل وتعد من اهم دوال ال vba لكن يجب فهمها بالطريقة الصحيحة ومتابعتها والتطوير في استخدامها وسنبدأ اليوم بالموضوع الاسهل " جملة اذا المشروطة if ... then " واذن الغالبية لديهم الالمام فيه ولكن حتى تتم الفائدة يجب البداية من السهل وهنا مرفق يشرح القاعدة بطريقة سهلة وبسيطة واتمتى التوفيق للجميع أخوكم عماد الحسامي HOSAMI IF THEN.rar

Twips and Pixels وحدات قياس الشاشة ونقاط شاشة العرض س : ما هي Twips و Pixels ج : الـ Twips هي عبارة عن وحدات قياسية لانظمة العرض وتعرف الوحدة Twip على انها 1/1440 بوصة . اما الـ Pixels هي عبارة عن نقاط الشاشة القياسية المعتمدة لوحدة قياس الصوره . والـ Pixel هي عبارة عن اي نقطة على شاشة العرض . مثال : نرغب في نموذج مقاس 400 × 300 وهذا يعني ان عرضه هو 400 بيكسل وطوله 300 بيكسل الان نريد استخدام هذا المقاس لتحديد طول وعرض النموذج اذا الامر سهل جدا نقوم بعرض النموذج في وضع التصميم ونختار حدث عند التحميل او الفتح ونضع هذا الكود Private Sub Form_Load() Me.Form.InsideHeight = 300 Me.Form.InsideWidth = 400 End Sub ونقوم بعرض النموذج ماذا نلاحظ نلاحظ ان النموذج صغير وليس هو المطلوب كما توقعنا فما هو الخلل او المشكلة في ذلك ؟ الاجابة : المشكلة ان برنامج الاكسيس لا يوجد به وحدة قياس اسمها Pixel ولكن يوجد به وحدة قياس Twip . س : يعني هذا اننا لابد من تحويل الـ Pixel الى Twip ؟ نعم لابد من التحويل لكي يتم التعرف عليها ووضعها سواء للعرض او الارتفاع . س : حسنا عرفنا ان الـ Twip الواحده تساوي 1/1440 بوصة فكم تساوي الـ Pixel ؟ ج : سؤال اكثر من رائع وسوف يوصلنا للحل كما ذكرنا سابقا ان البكسل Pixel عبارة عن نقطه على الشاشة لهذا لابد ان يكون لها طول وعرض لذا يكون طولها 88 وعرضها 90 وهذه ثابته لجميع مقاسات الشاشات . س : هذا يدل انها ليست مربعة الشكل ؟ ج : بالتأكيد والا لما حصلنا على دقة شاشة مقاس 480 × 640 او 600 × 800 او 768 × 1024 آه يعتي الموضوع صار بهذه الطريقه كلها حسابات في حسابات . طيب كيف نحسب كل هذه الامور من اجل تحويل الـ Pixel الى Twip او العكس لكي نستخدمه في النموذج . الاجابه : بما اننا في قسم البرمجه اذا لابد من استخدام دوال الـ API واستخدامها مع الكود لهذا نقوم بإضافة هذه الوظيفة Convert وتشمل على دالتين الدالة الاولى هي التحويل من التويب الى البيسكل ConvertTwipsToPixels والدالة الثانية هي عكسها التحويل من البيكسل الى التويب ConvertPixelsToTwips حسب الكود التالي التحويل من التويب الى البيكسل Option Compare Database Option Explicit Private Declare Function apiGetDC Lib "user32" Alias "GetDC" _ (ByVal hwnd As Long) As Long Private Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" _ (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _ (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Const LOGPIXELSX = 88 Private Const LOGPIXELSY = 90 Public Const DIRECTION_VERTICAL = 1 Public Const DIRECTION_HORIZONTAL = 0 Function fTwipsToPixels(lngTwips As Long, lngDirection As Long) As Long 'دالة التحويل من تويب الى بيكسل ' Function to convert Twips to pixels for the current screen resolution ' Accepts: ' lngTwips - the number of twips to be converted ' lngDirection - direction (x or y - use either DIRECTION_VERTICAL or DIRECTION_HORIZONTAL) ' Returns: ' the number of pixels corresponding to the given twips On Error GoTo E_Handle Dim lngDeviceHandle As Long Dim lngPixelsPerInch As Long lngDeviceHandle = apiGetDC(0) If lngDirection = DIRECTION_HORIZONTAL Then lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSX) Else lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSY) End If lngDeviceHandle = apiReleaseDC(0, lngDeviceHandle) fTwipsToPixels = lngTwips / 1440 * lngPixelsPerInch fExit: On Error Resume Next Exit Function E_Handle: MsgBox Err.Description, vbOKOnly + vbCritical, "Error: " & Err.Number Resume fExit End Function Function fPixelsToTwips(lngPixels As Long, lngDirection As Long) As Long دالة التحويل من بيكسل الى تويب ' Function to convert pixels to twips for the current screen resolution ' Accepts: ' lngPixels - the number of pixels to be converted ' lngDirection - direction (x or y - use either DIRECTION_VERTICAL or DIRECTION_HORIZONTAL) ' Returns: ' the number of twips corresponding to the given pixels On Error GoTo E_Handle Dim lngDeviceHandle As Long Dim lngPixelsPerInch As Long lngDeviceHandle = apiGetDC(0) If lngDirection = DIRECTION_HORIZONTAL Then lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSX) Else lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSY) End If lngDeviceHandle = apiReleaseDC(0, lngDeviceHandle) fPixelsToTwips = lngPixels * 1440 / lngPixelsPerInch fExit: On Error Resume Next Exit Function E_Handle: MsgBox Err.Description, vbOKOnly + vbCritical, "Error: " & Err.Number Resume fExit End Function ولاستخدامها نقوم بإستدعاؤها من خلال النموذج ليتم التحويل حسب الرقم المعطى لها مثال : حول الرقم التالي 400 من بيكسل الى تويب الاجابة : نستخدم دالة التحويل من البيسكل الى التويب بهذه الطريقة دالة التحويل من بيكسل الى تويب fPixelsToTwips(400,0) وسيكون الناتج هو 6000 تويب بالامكان وضع مربعي نص غير منضمين - في النموذج - مربع النص الاول نسميه مثلا N وهو يمثل الرقم الذي نكتبه فيه والاخر نسميه ConTwips وهو ناتج التحويل الى تويب لهذا نضع مصدر عنصر تحكم مربع النص ConTwips هو =fPixelsToTwips(nz([N];0);0) انظر المثال المرفق وللتحويل من تويب Twip الى بيكسل Pixel نستخدم الدالة الخاصة بالتحويل من تويب الى بكسل مثال : حول الرقم 9200 من تويب الى بيكسل الاجابة : نستخدم دالة التحويل من التويب الى البيكسل بهذه الطريقة دالة التحويل من تويب الى بكسل fTwipsToPixels(9200,0) وسيكون الناتج هو 613 بيكسل بالامكان وضع مربعي نص غير منضمين - في النموذج - مربع النص الاول نسميه مثلا N وهو يمثل الرقم الذي نكتبه فيه والاخر نسميه ConPixels وهو ناتج التحويل الى بيكسل لهذا نضع مصدر عنصر تحكم مربع النص ConPixels هو =fTwipsToPixels(nz([N];0);0) انظر المثال المرفق ملاحظة : جميع وحدات القياس تعتمد على دقة الشاشة فكلما زادت دقة الشاشة كلما صغرت مقاسات النقاط وزاد عددها في البوصة الواحده الخلاصة : 1. بواسطة هذه الدالة نسنطيع التحويل من البيكسل الى التويب والعكس 2. الغرض من هذه الدالة هو توحيد جميع مقاسات النموذج برقم محدد وثابت لا يتغير مهما تغيرت مقاس الشاشات فبعض الاشخاص لديهم مقاسات كبيرة الحجم والبعض الاخر لديهم مقاسات صغيره للشاشات ويفضل دائما هو استخدام المقاس الموحد 800 بيسكل × 600 بيكسل . 3. بعد الحصول على الرقم المطلوب وخاصة التويب نقوم بوضعه في الكود الاول السايق في اول المشاركه ليصبح بعد التعديل هو Private Sub Form_Load() Me.Form.InsideHeight = 4500 Me.Form.InsideWidth = 6000 End Sub المثال المرفق مع دالة التحويل ConvertTwipsToPixels.rar

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