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

جزاك الله خيرا يابو احمد على هذا الجهد والعطاء اخونا علي : الخلية في اكسس ليست كمثيلاتها في اكسل او وورد لذا فالتعامل معها يحتاج الى عمليات خاصة خارج نطاق خصائصها وفي مسألتك هذه نحن بحاجة الى عمليتين : الاولى : لتوسيع الخلية عموديا ( ويجب ان تتزامن الخلايا الاخرى معها في التمدد والتقلص ) الثانية : توسيط النص عموديا سواء كان سطرا واحدا او اكثر ( ويطبق ذلك على جميع الخلايا ) ولدي وحدتين نمطيتين تعمل كل واحدة على حدة ولم يتسنى لي الجمع بينهما ولكن العملية الثانية هي الاقرب الى حاجتك ومطلوبك وكثيرا ما استخدمها وهي تحتاج بدأً الى ضبط ارتفاع الخلايا على مقياس محدد ،كسطرين او ثلاثة ونحو ذلك حسب البيانات المتوقعة انظر التعديل على المرفق آمل ان يحوز على رضاك Database4.rar

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير اطلب المسامحة ممن راسلني ولم يجد رد مني هديتي لكم بعد هذه الغيبة Option Explicit '========================================================" ' بسم الله الرحمن الرحيم " '========================================================" ' (دالة تحويل الرقم الى نص باللغة العربية (تفقيط " ' kh_TextNum " '========================================================" 'Num الرقم " '========================================================" 'sex جنس العملة " 'FALSE ( فارغ او صفر مذكر ) " 'TRUE ( أو اي رقم غير الصفر مؤنث ) " '========================================================" 'sNameCurr اسم العملة الرئيسية مفرد " 'pNameCurr اسم العملة الرئيسية جمع " 'NameCurrDec اسم العملة الكسرية " 'Decimal_Count طول الكسر افتراضـياً : بدون اظهار الكسر " '===============================================================================================================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" ' ملاحظات ' (اولاً : العملة الرئيسية مثنى (يقوم بها الكود تلقائيا ' مع ملاحظة اذا اسم العملة ينتهي بالتاء المربوطة ' يجب ان يكتب كذلك وليس بالهاء ' ----------------------- ' ثانياً : اذا كانت العملة الرئيسية مفرد فارغاً تعتبر ' اسماء العملات (الجمع والكسري) فارغة تلقائيا ' ----------------------- 'ثالثاً : الكلمة الابتدائية بامكانك تغييرها او تجعلها فارغة Private Const MyBegTx As String = "فقط " ' "" ' ----------------------- ' MyTNum رابعا : يمكنك التغيير (اضافة,حذف,تحرير) في الثابت ' للفئات الصفرية للرقم ادناه Private Const MyTNum As String = "ألف-آلاف/مليون-ملايين/مليار-مليارات/بليون-بلايين/بليار-بليارات/ترليون-ترليونات/تريليار-تريليارات/كدرليون-كدرليونات" '===============================================================================================================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" Function kh_TextNum(Num As String, Optional sex As Boolean = False, Optional sNameCurr As String = "", Optional pNameCurr As String = "", Optional NameCurrDec As String = "", Optional Decimal_Count As Byte = 2) As String Dim Spp, zt Dim i%, ii%, pr% Dim MyMid$, nCurr$, Txt$, Txt1$, Txt2$ '====================================== If Not IsNumeric(Num) Then GoTo kh_Exit Spp = Split("/" & MyTNum, "/") ii = UBound(Spp) If Num < 0 Then Num = Abs(Num) '====================================== If Val(Num) > Val(String((ii + 1) * 3, "9") & ".999") Then GoTo kh_Exit '====================================== nCurr = sNameCurr & "-" & IIf(pNameCurr = "", sNameCurr, IIf(sNameCurr = "", "", pNameCurr)) '====================================== Txt1 = Format(Num, String((ii + 1) * 3, "0") & ".000") For i = 0 To ii MyMid = Mid(Txt1, (i * 3) + 1, 3) If MyMid Then zt = Mid(Txt1, (i * 3) + 4, Len(Txt1)) zt = IIf(ii - i, Int(zt), zt) Txt2 = IIf(ii - i, Trim(Spp(ii - i)), nCurr) pr = 1 + IIf(ii - i, 1, CInt(sex)) Txt = Txt & IIf(Len(Txt), " و", "") & kh_nText(MyMid, Txt2, pr, zt, CBool(sNameCurr <> "")) End If If i = ii Then If MyMid = 0 Then Txt = Txt & IIf(Len(Txt), " ", "صفر ") & sNameCurr Next '====================================== Txt = MyBegTx & Txt & kh_dText(Num, sNameCurr, NameCurrDec, Decimal_Count) '====================================== kh_Exit: kh_TextNum = Trim(Txt) End Function ' معالجة العدد من 1 الى 999 لكل فئات الرقم Private Function kh_nText(ByVal iNum As String, ByVal oMm As String, ByVal ibs As Integer, ByVal z As Boolean, ByVal tCu As Boolean) As String Dim Sp Dim Num1%, Num2%, Num3% Dim oM$, S$, S1$, nT$, nT0$, nT1$, nT2$ '====================================== Sp = Split("واحد,إحدى,اثنتان,ثلاث,أربع,خمس,ست,سبع,ثمان,تسع,عشر,إحدى ,اثنتا ", ",") '====================================== If ibs Then S = "ة": Sp(1) = Sp(0): Sp(2) = "اثنان": Sp(11) = "أحد ": Sp(12) = "اثنا " Else S1 = "ة" oM = Trim(Split(oMm, "-")(0)) '====================================== Num1 = Left(iNum, 1) Num2 = Right(iNum, 2) Select Case Num1 Case 1: nT0 = "مائة" Case 2: nT0 = "مائتا" & IIf(ibs = 2, IIf(Num2 < 3, "", "ن"), IIf(Num2 = 0 And oM <> "", "", "ن")) Case 3 To 9: nT0 = Sp(Num1) & "مائة" End Select '========================================= Num1 = Right(iNum, 2) Select Case Num1 Case 1, 2: If nT0 <> "" Then If ibs = 2 Then nT0 = nT0 & " " & oM Case 11 To 99: If oM <> "" Then If ibs Then If z Then oM = oM & "اً" End Select '----------------------------------------- Select Case Num1 Case 1 nT = IIf(oM = "", Sp(0) & S1, oM) oM = IIf(ibs <> 2 And oM <> "", Sp(0) & S1, "") Case 2 nT = IIf(oM = "", Sp(Num1), Replace(oM, "ة", "ت") & IIf(z = 0 And ibs = 2 And tCu, "ا", "ان")) oM = IIf(ibs <> 2 And oM <> "", Sp(Num1), "") Case 3 To 10 oM = Trim(Split(oMm, "-")(1)) nT = Sp(Num1) & S Case 11, 12 nT = Sp(Num1) & Sp(10) & S1 Case 13 To 19 nT = Sp(Num1 - 10) & S & " " & Sp(10) & S1 Case 20 To 99 Num2 = Right(Num1, 1) Num3 = Left(Num1, 1) If Num3 = 2 Then nT1 = "عشرون" Else nT1 = Sp(Num3) & "ون" nT2 = Sp(Num2) & IIf(Num2 > 2, S, "") & " و" & nT1 If Num2 = 0 Then nT2 = nT1 nT = nT2 End Select '====================================== S = IIf(nT = "" Or iNum < 100, "", " و") nT = Replace(nT, Sp(8) & "ة", Sp(8) & "ية") kh_nText = Trim(nT0 & S & nT & " " & oM) '====================================== End Function ' معالجة الكسر Private Function kh_dText(ByVal dNum As String, ByVal NCur As String, ByVal Ndec As String, ByVal co As Byte) As String Dim Td$, Td1$ On Error GoTo 1 If NCur = "" Then Ndec = "" Td = Format(Round(CCur(dNum - Int(dNum)), co), "0." & String(co, "0")) If Td = 0 Or Td = 1 Then Td1 = "": GoTo 1 If Len(Ndec) Then Ndec = " " & Ndec: Td1 = Td * CVar("1" & String(co, "0")) Else Ndec = " " & NCur: Td1 = Td Td1 = " و " & Chr(40) & Td1 & Chr(41) & Ndec 1: kh_dText = Td1 End Function دالة تحويل الرقم الى نص عربي.rar ================================================= الملف المعدل: هذا المرفق بامكانية تفقيط الكسر وامكانية ادخال كلمة نهاية النص دالة تحويل الرقم الى نص عربي.rar ================================================= رابط مباشر للملف

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

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

بعد العديد والعديد من الأكواد التى أستخدمت ، فى عمل " تجمد " للوقت أو التاريخ هذه طريقة بعيدة كل البعد عن هذا كله وتحقق المطلوب ، وأنا أستخدمها منذ مدة طويلة وتحقق ماأريد وهذا حل " وأتمنى أن تكون إضافة بالطبع " وهوحل بدون معادلات ولا أكواد وخطواتة كاللأتى: 1- ضع دالة "NOW " فى الخلية التى تريد إظهار الوقت بها 2- ثم نضغط على "F2 " 3- ثم نضغط على "F9 " 4- ثم نضغط على مفتاح "ENTER " من " KEY BOARD " 5- ثم كليك يمين على الخلية الذى يوجد بها الوقت ، ثم نختار " FORMAT CELLS " ومن هذه القائمة نختار تنسيق الوقت أو التاريخ أيهما نفضل ومبروووووووووك عليكم ثبات التاريخ أو الوقت مهما أغلقت أو فتحت أوراق عملك أتمنى أن تكون إضافة ومفيدة للأخو الزملاء تقبلوا تحياتى

شكرا ابا احمد وهي واحدة من طرق الحماية حيث يتم حفظ كلمة المرور داخل وندوز

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

فهرس الحقات السابقة http://www.officena.net/ib/index.php?showtopic=55853 لجديد الدورة يمكنك متابعة المنتدى الخاص بالدورات http://www.officena.net/ib/index.php?showforum=161 الجمعة 19 سبتمبر العاشرة مساء بتوقبت الامارات - التاسعة بتوقيت القاهرة للتسجيل لحضور الحلقة على الهواء https://attendee.gotowebinar.com/register/2779326062578930945 محتويات الحلقة التعرف على أوامر البرنامج المختلقة فى الفيزيو و استخداماتها ( نظرة عامة على كل قوائم البرنامج) تسجيل الحلقة

جزاك الله عنا كل خير كان درس مفيد و شيق

مشكور يا غالي وما قصرت وربنا يجزيك كل خير اللهم آمين

تم ارسالها لك اخي منذ يوم امس

شكراَ لكم على دورة الفيزيو المفيدة

العمل جيد كبداية جرى التحسين عليه قليلاً ليعمل اكسل علي ادراج التواريخ و تمييز العطل اوتوماتيكياً انظر الى الصفحة 2 ملف اليومية 1.rar

تفضل اخي العزيز . وللحفاظ على حقوق الناشر سوف ارسل لك كلمة المرور في رساله خاصة القاعدة المركزية.rar

السلام عليكم ضع المعادلة التالية في الخلية C8 واسحبها لاسفل =IFERROR(LEFT(VLOOKUP($A8;تكويد_تعريفات!$A$2:$B$10;2;0);1)&TEXT(SUMPRODUCT(N(LEFT($C$7:C7;1)=LEFT(VLOOKUP($A8;تكويد_تعريفات!$A$2:$B$10;2;0);1)))+1;"000")&"-000";"") تحياتي

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

السلام عليكم تم معالجة الأمر فزر وانتقال 1.rar

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

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