10:52 AM |الساعة الآن   
 
العودة ملتقى الموظف الجزائرى  :: 

منتدى الميزانيات والصفقات العمومية

 :: 

الاجــور والمنح والتعويضات






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

الرئيسيةالبوابةبحـثس .و .جدخولالتسجيل
اعلان هام للمسجلين الجدد :بمجرد التسجيل يتم إرسال كود التفعيل إلى حسابك .. أي الإيميل الذي وضعته عند التسجيل بالمنتدى ... إذهب إلى علبة البريد فإذا لم تجده في الرسائل الواردة حاول أن تبحث عنه في صندوق بريد الغير مرغوب فيه SPAM



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


شاطر
 #1  
السبت 07 أغسطس 2010, 12:31
 
 
 
ذكر
الاقامة : بلد المليون ونصف المليون شهيد
المشاركات : 2300
نقاط : 3304
تاريخ التسجيل : 22/07/2010
العمل : موظف
المزاج المزاج : صلى الله على النبي وآله وصحبه أجمعين
افتراضيلمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

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

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



 #2  
السبت 07 أغسطس 2010, 12:36
مشرف منتدى الأجور و التعويضات
مشرف منتدى الأجور و التعويضات
 
ذكر
الاقامة : AD
المشاركات : 1015
نقاط : 1284
تاريخ التسجيل : 09/06/2010
العمر : 38
العمل : CRM HAMMAM RIGHA
افتراضيرد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

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


 #3  
السبت 07 أغسطس 2010, 12:37
مشرف منتدى الأجور و التعويضات
مشرف منتدى الأجور و التعويضات
 
ذكر
الاقامة : AD
المشاركات : 1015
نقاط : 1284
تاريخ التسجيل : 09/06/2010
العمر : 38
العمل : CRM HAMMAM RIGHA
افتراضيرد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

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


 #4  
السبت 07 أغسطس 2010, 12:49
 
ذكر
الاقامة : 阿尔及利亚
المشاركات : 3111
نقاط : 5894
تاريخ التسجيل : 15/08/2009
العمل : 人理
المزاج المزاج : 美丽
افتراضيرد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

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

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

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


بالتوفيق للجميع


 #5  
السبت 07 أغسطس 2010, 12:54
 
 
 
ذكر
الاقامة : بلد المليون ونصف المليون شهيد
المشاركات : 2300
نقاط : 3304
تاريخ التسجيل : 22/07/2010
العمل : موظف
المزاج المزاج : صلى الله على النبي وآله وصحبه أجمعين
افتراضيرد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

الرابط يعمل معي ؟



 #6  
السبت 07 أغسطس 2010, 12:58
 
ذكر
الاقامة : 阿尔及利亚
المشاركات : 3111
نقاط : 5894
تاريخ التسجيل : 15/08/2009
العمل : 人理
المزاج المزاج : 美丽
افتراضيرد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

الرابط يعمل

NoToTx1.html


 #7  
السبت 07 أغسطس 2010, 14:09
 
 
 
انثى
الاقامة : الجزائر
المشاركات : 132
نقاط : 196
تاريخ التسجيل : 01/08/2010
العمل : Ingenieur en Informatique
المزاج المزاج : مرحة
افتراضيرد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

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

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



 #8  
الأحد 08 أغسطس 2010, 00:05
 
 
 
ذكر
الاقامة : algerie
المشاركات : 187
نقاط : 342
تاريخ التسجيل : 27/07/2010
العمل : CHEF SREVICE DE FINANCE ET COMPTABILITE
افتراضيرد: لمن يجيد إستعمال الماكروا ، هذا ماكروا لكتابة الأرقام بالأحرف

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






 
الإشارات المرجعية


  
وما من كاتب إلا سيفنى . ويبقي الدهر ما كتبت يداه



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

BB code is متاحة
كود [IMG] متاحة
كود HTML متاحة