أكاديمية الصقر للتدريب

اعلن هنا
أكاديمية الصقر للتدريب
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز
المشرف المتميز
المراقب المتميز
المدير المتميز
الموضوع المتميز
القسم المتميز
khaled alborene Eslam Abdullah لا تميز خلال هذه الفترة YasserKhalil الاصدار الأول لشيت المرتبات الاوتوماتيك - حسام خطاب اكسيل اسئله واجابات



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





شرح لكيفيه عمل ماكرو وكود تفقيط علي الوورد

اولا من قائمة المطور تضغط علي وضع التصميم وتقوم بانشاء 2 مربع نص تقوم بانشاء مديول جديد من ووضع كود التفقيط بداخله [co ..



06-09-2018 10:58 مساء
emad eldwady
menu_open
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 08-06-2018
رقم العضوية : 6651
المشاركات : 33
الجنس : ذكر
تاريخ الميلاد : 13-5-1986
يتابعهم : 5
يتابعونه : 0
قوة السمعة : 93
الاعجاب : 20
 offline 
اولا من قائمة المطور  تضغط علي وضع التصميم
وتقوم بانشاء 2 مربع نص
تقوم بانشاء مديول جديد  من ووضع كود التفقيط بداخله

'========================================================"
'      (دالة تحويل الرقم الى نص باللغة العربية (تفقيط      "
'                     kh_TextNum                         "
'========================================================"
'Num                     الرقم                           "
'========================================================"
'Sex                   جنس العملة                        "
'        FALSE   ( أو فارغ او صفر مذكر )                 "
'        TRUE   (  أو اي رقم غير الصفر مؤنث )             "
'========================================================"
'NCurr_Si        اسم العملة الرئيسية مفرد                "
'NCurr_Pl          اسم العملة الرئيسية جمع                "
'NCurrDec_Si           اسم العملة الكسرية                "
'Decimal_Count  طول الكسر افتراضـياً : بدون اظهار الكسر    "
'========================================================"
'            : للدلالة على تفقيط الكسر عين التالي            "
'NCurrDec_pl       اسم العملة الكسرية جمع                 "
'dSex               جنس عملة الكسر                       "
'        FALSE   ( أو فارغ او صفر مذكر )                 "
'        TRUE   (  أو اي رقم غير الصفر مؤنث )             "
'========================================================"
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
'                       ملاحظات
'  (اولاً : اذا اسم العملة ينتهي بالتاء المربوطة
'              يجب ان يكتب كذلك وليس بالهاء
'                -----------------------
'      ثانياً : العملة الافتراضية هي العملة السعودية
'               وجنس العملة والكسر مؤنث
'                -----------------------
'("" ثالثاً : امكانية إضافة كلمة بداية ونهاية النص (فارغة
Private Const MyBegTx As String = ""
Private Const MyEndTx As String = " فقط لاغير"
'                -----------------------
' MyTNum  رابعا : يمكنك التغيير (اضافة,حذف,تحرير) في الثابت
'             للفئات الصفرية للرقم ادناه
Private Const MyTNum As String = "ألف-آلاف/مليون-ملايين/مليار-مليارات/بليون-بلايين/بليار-بليارات/ترليون-ترليونات/تريليار-تريليارات/كدرليون-كدرليونات"
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
'==============================================================================================================================================="
Private Const wow As String * 2 = " و"
'==============================================================================================================================================="
 
Function CurrText(Num As String, _
Optional Sex As Boolean = True, _
Optional NCurr_Si As String = "ريال", _
Optional NCurr_Pl As String = "ريالات", _
Optional dSex As Boolean = True, _
Optional NCurrDec_Si As String = "هللة", _
Optional NCurrDec_Pl 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
If Num = 0 Then Txt = MyBegTx & "صفر " & NCurr_Si: 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 = NCurr_Si & "-" & IIf(NCurr_Pl = "", NCurr_Si, IIf(NCurr_Si = "", "", NCurr_Pl))
'======================================
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), 1)
        Txt2 = IIf(ii - i, Trim(Spp(ii - i)), nCurr)
        pr = 1 + IIf(ii - i, 1, CInt(Sex))
        Txt = Txt & IIf(Len(Txt), wow, "") & kh_nText(MyMid, Txt2, pr, zt, CBool(NCurr_Si <> ""))
    End If
    If i = ii Then If MyMid = 0 Then Txt = Txt & IIf(Len(Txt), " " & NCurr_Si, IIf(Decimal_Count = 0, "صفر", ""))
Next
'======================================
Txt = MyBegTx & Txt & kh_dText(Num, NCurr_Si, Trim(NCurrDec_Si), Decimal_Count, Trim(NCurrDec_Pl), dSex) & MyEndTx
'======================================
kh_Exit:
CurrText = 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, "") & wow & nT1
        If Num2 = 0 Then nT2 = nT1
        nT = nT2
End Select
'======================================
S = IIf(nT = "" Or iNum < 100, "", wow)
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, ByVal Ndec_pl As String, ByVal dsx As Boolean) As String
Dim Td$, dwow$, Td1$
On Error GoTo 1
If co = 0 Then 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 Int(dNum) Then dwow = wow
If Len(Ndec) Then
    Ndec = " " & Ndec
    Td1 = Td * CVar("1" & String(co, "0"))
    If Len(Ndec_pl) And co < 4 Then Td1 = dwow & kh_nText(Format(Td1, "000"), Ndec & "-" & Ndec_pl, 1 + CInt(dsx), 1, 0): GoTo 1
Else
    Ndec = " " & NCur: Td1 = Td
End If
Td1 = dwow & " " & Chr(40) & Td1 & Chr(41) & Ndec
1: kh_dText = Td1
End Function



ثم بعد ذللك تقوم بالضغط علي  مربع النص الاول مرتين وتكتب التالي
Private Sub TextBox1_Change()
TextBox2.Value = CurrText(TextBox1.Value)
End Sub

وتقفل  وضع التصميم  وتحفظ الملف بصيغه ماكرو للورد وبذلك يكون تم الانتهاء من الكود ويمكنك تجربة كتابة المبالغ




لرؤية الروابط والمرفقات عليك الرد على الموضوع


أثارت هذه المشاركة إعجاب: ali mohamed ali، YasserKhalil، قتيبة الحسني، عبدالله الصاري، محمد حسن المحمد، Yasser Elaraby،



07-09-2018 12:29 صباحا
مشاهدة مشاركة منفردة [1]
ali mohamed ali
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 624
الدولة : مصر
الجنس : ذكر
يتابعهم : 0
يتابعونه : 28
قوة السمعة : 3014
الاعجاب : 973
 offline 
look/images/icons/i1.gif شرح لكيفيه عمل ماكرو وكود تفقيط علي الوورد
أحسنت استاذ عماد بارك الله فيك عمل رائع
ولو ممكن نقل الموضوع الى قسم وورد شروحات ودروس
جزاك الله كل خير

أثارت هذه المشاركة إعجاب: YasserKhalil، emad eldwady،


توقيع :ali mohamed ali
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
 الاخرين لوجه الله وان تحتسب له اجر عند الله

07-09-2018 06:24 صباحا
مشاهدة مشاركة منفردة [2]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 4938
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 12
يتابعهم : 0
يتابعونه : 327
قوة السمعة : 14182
الاعجاب : 5279
 offline 
look/images/icons/i1.gif شرح لكيفيه عمل ماكرو وكود تفقيط علي الوورد
بارك الله فيك أخي الكريم عماد وجزاك الله خيراً
موضوع جميل وخصوصاً أنه لم يتطرق أحد لموضوع التفقيط في برنامج الورد
تقبل تحياتي

أثارت هذه المشاركة إعجاب: emad eldwady، محمد حسن المحمد،



17-10-2018 11:19 مساء
مشاهدة مشاركة منفردة [3]
مصطفى المياحي
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 17-10-2018
رقم العضوية : 8402
المشاركات : 8
الجنس : ذكر
تاريخ الميلاد : 15-5-1985
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 18
الاعجاب : 4
 offline 
look/images/icons/i1.gif شرح لكيفيه عمل ماكرو وكود تفقيط علي الوورد
بارك الله فيك 




19-10-2018 08:14 مساء
مشاهدة مشاركة منفردة [4]
عبدالله الصاري
menu_open
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-08-2017
رقم العضوية : 227
المشاركات : 35
الدولة : ليبيا
الجنس : ذكر
تاريخ الميلاد : 25-1-1964
يتابعهم : 6
يتابعونه : 2
قوة السمعة : 129
الاعجاب : 33
 offline 
look/images/icons/i1.gif شرح لكيفيه عمل ماكرو وكود تفقيط علي الوورد
بارك الله فيك
ابداع




21-10-2018 09:05 مساء
مشاهدة مشاركة منفردة [5]
mahmoudelkomy
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 27-08-2017
رقم العضوية : 244
المشاركات : 7
الجنس : ذكر
تاريخ الميلاد : 17-5-1983
يتابعهم : 5
يتابعونه : 0
قوة السمعة : 18
الاعجاب : 4
 offline 
look/images/icons/i1.gif شرح لكيفيه عمل ماكرو وكود تفقيط علي الوورد
رائع
 




22-10-2018 02:01 مساء
مشاهدة مشاركة منفردة [6]
محمد أبو العنين
menu_open
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 159
المشاركات : 16
الجنس : ذكر
تاريخ الميلاد : 9-6-1969
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 24
الاعجاب : 7
 offline 
look/images/icons/i1.gif شرح لكيفيه عمل ماكرو وكود تفقيط علي الوورد
جزاك الله خيرا
 




22-10-2018 02:10 مساء
مشاهدة مشاركة منفردة [7]
hyasser
menu_open
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 29-08-2017
رقم العضوية : 288
المشاركات : 38
الجنس : ذكر
تاريخ الميلاد : 4-1-1964
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 40
الاعجاب : 15
 offline 
look/images/icons/i1.gif شرح لكيفيه عمل ماكرو وكود تفقيط علي الوورد
شكرا استاذ




26-10-2018 01:16 مساء
مشاهدة مشاركة منفردة [8]
محمد حسن المحمد
menu_open
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-08-2017
رقم العضوية : 80
المشاركات : 279
الجنس : ذكر
تاريخ الميلاد : 14-5-1965
يتابعهم : 60
يتابعونه : 14
قوة السمعة : 1816
الاعجاب : 534
 offline 
look/images/icons/i1.gif شرح لكيفيه عمل ماكرو وكود تفقيط علي الوورد
أحسنتم بارك الله فيكم 

أثارت هذه المشاركة إعجاب: YasserKhalil،


توقيع :محمد حسن المحمد

الرفقُ ما كان في شيءٍ إلاَّ زانهُ ، وما نُزع من شيءٍ إلاَّ شانُه ،اللينُ في الخطاب ، البسمةُ الرائقةُ على المحيا، 
الكلمةُ الطيبةُ عند اللقاء ، هذه حُلَلٌ منسوجةٌ يرتديها السعداء


27-10-2018 06:17 صباحا
مشاهدة مشاركة منفردة [9]
السيد عبد النبي مقلاش
menu_open
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 06-08-2018
رقم العضوية : 7526
المشاركات : 25
الجنس : ذكر
تاريخ الميلاد : 30-3-1965
يتابعهم : 0
يتابعونه : 1
قوة السمعة : 32
الاعجاب : 11
 offline 
look/images/icons/i1.gif شرح لكيفيه عمل ماكرو وكود تفقيط علي الوورد
شكرا جزيلا







الكلمات الدلالية
لكيفيه ، ماكرو ، وكود ، تفقيط ، الوورد ،


 







الساعة الآن 03:06 صباحا

أعلن هنا
أعلن هنا
أعلن هنا