لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل

لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

مُساهمة من طرف كادي في السبت 07 أغسطس 2010, 12:31

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

الرابط
[ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط]
avatar
كادي
 
 

ذكر

الاقامة : بلد المليون ونصف المليون شهيد

المشاركات : 2300

نقاط : 3304

تاريخ التسجيل : 22/07/2010

العمل : موظف
المزاج المزاج : صلى الله على النبي وآله وصحبه أجمعين


الرجوع الى أعلى الصفحة اذهب الى الأسفل

رد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

مُساهمة من طرف AYACHE AEK في السبت 07 أغسطس 2010, 12:36

الرابط لا يعمل سا سي قادي

AYACHE AEK
مشرف منتدى الأجور و التعويضات

مشرف منتدى الأجور و التعويضات

ذكر

الاقامة : AD

المشاركات : 1030

نقاط : 1305

تاريخ التسجيل : 09/06/2010

العمر : 39

العمل : CRM HAMMAM RIGHA

الرجوع الى أعلى الصفحة اذهب الى الأسفل

رد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

مُساهمة من طرف AYACHE AEK في السبت 07 أغسطس 2010, 12:37

الرابط لا يعمل سا سي قادي

AYACHE AEK
مشرف منتدى الأجور و التعويضات

مشرف منتدى الأجور و التعويضات

ذكر

الاقامة : AD

المشاركات : 1030

نقاط : 1305

تاريخ التسجيل : 09/06/2010

العمر : 39

العمل : CRM HAMMAM RIGHA

الرجوع الى أعلى الصفحة اذهب الى الأسفل

رد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

مُساهمة من طرف ابو محمد في السبت 07 أغسطس 2010, 12:49

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

لكيفية التركيب الشرح فى ردود هذا الدرس

[ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط]


بالتوفيق للجميع
توقيع : ابو محمد




لايحزنك انك فشلت ما دمت تحاول الوقوف على قدميك من جديد
.المهنية سلاحنا الفعال!
لا يمكن أن نواجه هذا العالم الذكي بالهبل والدجل والكسل والشلل!
لتنمية مهارتك تابعنا على


مدونة الموظف الجزائرى

[ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذه الصورة]


avatar
ابو محمد


ذكر

الاقامة : 阿尔及利亚

المشاركات : 3137

نقاط : 5937

تاريخ التسجيل : 15/08/2009

العمل : 人理
المزاج المزاج : 美丽


الرجوع الى أعلى الصفحة اذهب الى الأسفل

رد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

مُساهمة من طرف كادي في السبت 07 أغسطس 2010, 12:54

الرابط يعمل معي ؟
avatar
كادي
 
 

ذكر

الاقامة : بلد المليون ونصف المليون شهيد

المشاركات : 2300

نقاط : 3304

تاريخ التسجيل : 22/07/2010

العمل : موظف
المزاج المزاج : صلى الله على النبي وآله وصحبه أجمعين


الرجوع الى أعلى الصفحة اذهب الى الأسفل

رد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

مُساهمة من طرف ابو محمد في السبت 07 أغسطس 2010, 12:58

الرابط يعمل

NoToTx1.html
توقيع : ابو محمد




لايحزنك انك فشلت ما دمت تحاول الوقوف على قدميك من جديد
.المهنية سلاحنا الفعال!
لا يمكن أن نواجه هذا العالم الذكي بالهبل والدجل والكسل والشلل!
لتنمية مهارتك تابعنا على


مدونة الموظف الجزائرى

[ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذه الصورة]


avatar
ابو محمد


ذكر

الاقامة : 阿尔及利亚

المشاركات : 3137

نقاط : 5937

تاريخ التسجيل : 15/08/2009

العمل : 人理
المزاج المزاج : 美丽


الرجوع الى أعلى الصفحة اذهب الى الأسفل

رد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

مُساهمة من طرف ismahane في السبت 07 أغسطس 2010, 14:09

الرابط جيد
و ها هو المحتوى :

Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String
Dim MyArry1(0 To 9) As String
Dim MyArry2(0 To 9) As String
Dim MyArry3(0 To 9) As String
Dim Myno As String
Dim GetNo As String
Dim RdNo As String
Dim My100 As String
Dim My10 As String
Dim My1 As String
Dim My11 As String
Dim My12 As String
Dim GetTxt As String
Dim Mybillion As String
Dim MyMillion As String
Dim MyThou As String
Dim MyHun As String
Dim MyFraction As String
Dim MyAnd As String
Dim I As Integer
Dim ReMark As String


If TheNo > 999999999999.99 Then Exit Function

If TheNo < 0 Then
TheNo = TheNo * -1
ReMark = " "
Else
ReMark = " "
End If

If TheNo = 0 Then
NoToTxt = "صفر"
Exit Function
End If

MyAnd = " و"
MyArry1(0) = ""
MyArry1(1) = "مائة"
MyArry1(2) = "مائتان"
MyArry1(3) = "ثلاثمائة"
MyArry1(4) = "أربعمائة"
MyArry1(5) = "خمسمائة"
MyArry1(6) = "ستمائة"
MyArry1(7) = "سبعمائة"
MyArry1(8) = "ثمانمائة"
MyArry1(9) = "تسعمائة"

MyArry2(0) = ""
MyArry2(1) = " عشرة"
MyArry2(2) = "عشرون"
MyArry2(3) = "ثلاثون"
MyArry2(4) = "أربعون"
MyArry2(5) = "خمسون"
MyArry2(6) = "ستون"
MyArry2(7) = "سبعون"
MyArry2(8) = "ثمانون"
MyArry2(9) = "تسعون"

MyArry3(0) = ""
MyArry3(1) = "واحد"
MyArry3(2) = "اثنان"
MyArry3(3) = "ثلاثة"
MyArry3(4) = "أربعة"
MyArry3(5) = "خمسة"
MyArry3(6) = "ستة"
MyArry3(7) = "سبعة"
MyArry3(8) = "ثمانية"
MyArry3(9) = "تسعة"
'======================

GetNo = Format(TheNo, "000000000000.00")

I = 0
Do While I < 15

If I < 12 Then
Myno = Mid$(GetNo, I + 1, 3)
Else
Myno = "0" + Mid$(GetNo, I + 2, 2)
End If

If (Mid$(Myno, 1, 3)) > 0 Then

RdNo = Mid$(Myno, 1, 1)
My100 = MyArry1(RdNo)
RdNo = Mid$(Myno, 3, 1)
My1 = MyArry3(RdNo)
RdNo = Mid$(Myno, 2, 1)
My10 = MyArry2(RdNo)

If Mid$(Myno, 2, 2) = 11 Then My11 = "إحدى عشرة"
If Mid$(Myno, 2, 2) = 12 Then My12 = "إثنتى عشرة"
If Mid$(Myno, 2, 2) = 10 Then My10 = "عشرة"
If ((Mid$(Myno, 1, 1)) > 0) And ((Mid$(Myno, 2, 2)) > 0) Then My100 = My100 + MyAnd
If ((Mid$(Myno, 3, 1)) > 0) And ((Mid$(Myno, 2, 1)) > 1) Then My1 = My1 + MyAnd

GetTxt = My100 + My1 + My10

If ((Mid$(Myno, 3, 1)) = 1) And ((Mid$(Myno, 2, 1)) = 1) Then
GetTxt = My100 + My11
If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My11
End If

If ((Mid$(Myno, 3, 1)) = 2) And ((Mid$(Myno, 2, 1)) = 1) Then
GetTxt = My100 + My12
If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My12
End If

If (I = 0) And (GetTxt <> "") Then
If ((Mid$(Myno, 1, 3)) > 10) Then
Mybillion = GetTxt + " مليار"
Else
Mybillion = GetTxt + " مليارات"
If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " مليار"
If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ملياران"
End If
End If

If (I = 3) And (GetTxt <> "") Then

If ((Mid$(Myno, 1, 3)) > 10) Then
MyMillion = GetTxt + " مليون"
Else
MyMillion = GetTxt + " ملايين"
If ((Mid$(Myno, 1, 3)) = 1) Then MyMillion = " مليون"
If ((Mid$(Myno, 1, 3)) = 2) Then MyMillion = " مليونان"
End If
End If

If (I = 6) And (GetTxt <> "") Then
If ((Mid$(Myno, 1, 3)) > 10) Then
MyThou = GetTxt + " ألف"
Else
MyThou = GetTxt + " آلاف"
If ((Mid$(Myno, 3, 1)) = 1) Then MyThou = " ألف"
If ((Mid$(Myno, 3, 1)) = 2) Then MyThou = " ألفان"
End If
End If

If (I = 9) And (GetTxt <> "") Then MyHun = GetTxt
If (I = 12) And (GetTxt <> "") Then MyFraction = GetTxt
End If

I = I + 3
Loop

If (Mybillion <> "") Then
If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd
End If

If (MyMillion <> "") Then
If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd
End If

If (MyThou <> "") Then
If (MyHun <> "") Then MyThou = MyThou + MyAnd
End If

If MyFraction <> "" Then
If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then
NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur
Else
NoToTxt = ReMark + MyFraction + " " + MySubCur
End If
Else
NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur
End If

End Function
avatar
ismahane
 
 

انثى

الاقامة : الجزائر

المشاركات : 141

نقاط : 203

تاريخ التسجيل : 01/08/2010

العمل : Ingenieur en Informatique
المزاج المزاج : مرحة


الرجوع الى أعلى الصفحة اذهب الى الأسفل

رد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

مُساهمة من طرف braktia في الأحد 08 أغسطس 2010, 00:05

انا لم افهم شي بخصوص هذا الموضوع ارجو التوضيح اكثر خاصة اصحاب الاحتصاص informatique
avatar
braktia
 
 

ذكر

الاقامة : algerie

المشاركات : 195

نقاط : 352

تاريخ التسجيل : 27/07/2010

العمل : CHEF SREVICE DE FINANCE ET COMPTABILITE

الرجوع الى أعلى الصفحة اذهب الى الأسفل

استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة

إنشاء حساب أو تسجيل الدخول لتستطيع الرد

تحتاج إلى أن يكون عضوا لتستطيع الرد.

انشئ حساب

يمكنك الانضمام للمنتدى فهملية التسجيل سهلة !


انشاء حساب جديد

تسجيل الدخول

اذا كنت مسجل معنا فيمكنك الدخول بالضغط هنا


تسجيل الدخول

 
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى

  • © phpBB | انشئ منتدى | منتدى مجاني للدعم و المساعدة | إتصل بنا | التبليغ عن محتوى مخالف | الحصول على مدونة