منتديات اميه ونسة التعليمية

مرحبا بك عزيزي الزائر. المرجوا منك أن تعرّف بنفسك و تدخل المنتدى معنا. إن لم يكن لديك حساب بعد, نتشرف بدعوتك لإنشائه

رياضيات . فيزياء .لغات .كل مايفيد الاستاذ و التلميذ وطالب العلم


    التفقيط في الأكسيل "

    شاطر

    علي
    المشرف
    المشرف

    ذكر عدد الرسائل : 1733
    تاريخ التسجيل : 10/07/2008

    التفقيط في الأكسيل "

    مُساهمة من طرف علي في 2010-08-09, 02:27

    http://edu.arabsgate.com/showthread.php?t=503287


    _________________

    Bou_m
    .
    .

    ذكر عدد الرسائل : 2368
    تاريخ التسجيل : 05/07/2008

    رد: التفقيط في الأكسيل "

    مُساهمة من طرف Bou_m في 2010-08-10, 03:06

    في هذا الشرح كيف يتم تفقيط الارقام (تحويل الرقم من رقم الى حروف ) مثل 1 يصبح "واحد"
    طبعا المثال المستخدم في الشرح هو لاحد الاخوه طلب شرح طريقه التفقيط على مثاله واذا يوجد اي خطاء في المثال هذا راجع للمبرمج صاحب المثال
    رابط المشاركه http://forum.accesswordkingdome.com/...ead.php?t=2377

    رابط الشرح
    TextNum.rar - 2.05MB

    او
    http://www.2shared.com/file/8709196/41697a39/TextNum.html
    او
    تحميل الملف من هنا


    _________________

    Bou_m
    .
    .

    ذكر عدد الرسائل : 2368
    تاريخ التسجيل : 05/07/2008

    رد: التفقيط في الأكسيل "

    مُساهمة من طرف Bou_m في 2010-08-10, 03:29

    تفقيط عربي انجليزي لأبي هادي by محمد طاهر
    تاريخ الإضافة
    30 October 2007 - 07:58 PM
    آخر تحديث
    30 October 2007 - 07:58 PM
    File Size
    32.1K (Estimated Download Times)
    Views
    2574
    Downloads
    839
    Support Topic
    إضغط هنا لزيارة موضوع الحوار حول هذا الملف تفقيط عربي انجليزي محدث
    للأكسس والأكسل
    لأبى هادي

    وصلة الموضوع:
    [url=http://www.officena.com/ib/index.php?showtopic=315]http://www.officena....p?showtopic=315[/url]


    _________________

    Bou_m
    .
    .

    ذكر عدد الرسائل : 2368
    تاريخ التسجيل : 05/07/2008

    رد: التفقيط في الأكسيل "

    مُساهمة من طرف Bou_m في 2010-08-10, 05:48

    التفقيط بالقرنسية
    الكووووود
    Function chiffrelettre(s)
    Dim a As Variant, gros As Variant
    a = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
    "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", _
    "dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt quatre", _
    "vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et un", _
    "trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", _
    "trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante trois", _
    "quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
    "quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
    "cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", _
    "cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
    "soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
    "soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize", _
    "soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
    "soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
    "quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
    "quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
    "quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
    "quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix sept", _
    "quatre-vingt dix huit", "quatre-vingt dix neuf")
    gros = Array("", "billions", "milliards", "millions", "mille", "Dinars", "billion", _
    "milliard", "million", "mille", "Dinar")
    sp = Space(1)
    chaine = "00000000000000"
    centime = s * 100 - (Int(s) * 100)
    s = Str(Int(s)): lg = Len(s) - 1: s = Right(s, lg): lg = Len(s)
    If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
    s = chaine + s
    'billions au centaines
    gp = 1
    For k = 1 To 5
    x = Mid(s, gp, 1): c = a(Val(x))
    x = Mid(s, gp + 1, 2): d = a(Val(x))
    If k = 5 Then
    If t2 <> "" And c & d = "" Then mydz = "Dinars" & sp: GoTo fin
    If t <> "" And c = "" And d = "un" Then mydz = "un Dinars" & sp: GoTo fin
    If t <> "" And t2 = "" And c & d = "" Then mydz = "d'Dinars" & sp: GoTo fin
    If t & c & d = "" Then myct = "": mydz = "": GoTo fin
    End If
    If c & d = "" Then GoTo fin
    If d = "" And c <> "" And c <> "un" Then mydz = c & sp & "cents " & gros(k) & sp: GoTo fin
    If d = "" And c = "un" Then mydz = "cent " & gros(k) & sp: GoTo fin
    If d = "un" And c = "" Then myct = IIf(k = 4, gros(k) & sp, "un " & gros(k + 5) & sp): GoTo fin
    If d <> "" And c = "un" Then mydz = "cent" & sp
    If d <> "" And c <> "" And c <> "un" Then mydz = c & sp & "cent" + sp
    myct = d & sp & gros(k) & sp
    fin:
    t2 = mydz & myct
    t = t & mydz & myct
    mydz = "": myct = ""
    gp = gp + 3
    Next
    d = a(centime)
    If t <> "" Then myct = IIf(centime = 1, " centime", " centimes")
    If t = "" Then myct = IIf(centime = 1, " centime d'Dinar", " centimes d'Dinar")
    If centime = 0 Then d = "": myct = ""
    chiffrelettre = t & d & myct
    End Function


    _________________

    Bou_m
    .
    .

    ذكر عدد الرسائل : 2368
    تاريخ التسجيل : 05/07/2008

    رد: التفقيط في الأكسيل "

    مُساهمة من طرف Bou_m في 2010-08-10, 05:52

    unit SimpleFigures;التفقيط بالعربي
    interface
    uses
    SysUtils;
    function ArabicSimpleFigure(const StrNumber: string; Sex: Boolean; var ResultStr: string; const CurName, CurPartName: string;CurPartLength:Integer=2): Boolean;
    implementation
    function NoDoubleSpace(vStr: string): string;
    var
    i: integer;
    begin
    i := 0;
    while i < length(vStr) do
    begin
    i := i + 1;
    if (vStr[i] = ' ') and (vStr[i + 1] = ' ') then
    Delete(vStr, i + 1, 1);
    end;
    Result := vStr;
    end;
    const
    FirstArray: array[1..9, 0..1] of string = (('واحد', 'إحدى'), ('اثنان', 'اثنا'), ('ثلاثة', 'ثلاث'), ('أربعة', 'أربع'),
    ('خمسة', 'خمس'), ('ستة', 'ست'), ('سبعة', 'سبع'), ('ثمانية', 'ثمان'), ('تسعة', 'تسع'));
    FirstArray1: array[1..2, 0..1] of string = (('أحد', 'إحدى'), ('اثنا', 'اثنتا'));
    SecondArray: array[1..9, 0..1] of string = (('عشرة', 'عشر'), ('عشرون', 'عشرون'), ('ثلاثون', 'ثلاثون'), ('أربعون', 'أربعون'), ('خمسون', 'خمسون'),
    ('ستون', 'ستون'), ('سبعون', 'سبعون'), ('ثمانون', 'ثمانون'), ('تسعون', 'تسعون'));
    ThirdArray: array[1..9] of string = ('مائة', 'مائتان', 'ثلاثمائة', 'أربعمائة', 'خمسمائة', 'ستمائة',
    'سبعمائة', 'ثمانمائة', 'تسعمائة');
    function GetNum(var Str1: string; Sex:Boolean; Index: integer): string;
    var
    StrLen: integer;
    Indx: array[1..3] of integer;
    TmpArray: array[0..2] of string;
    TmpStr: string;
    begin
    Indx[1] := -1;
    Indx[2] := -1;
    Indx[3] := -1;
    StrLen := Length(Str1);
    Indx[1] := StrToInt(Copy(Str1, StrLen, 1));
    if (Indx[1] <> 0) then
    TmpArray[0] := FirstArray[Indx[1], Ord(Sex)] + ' ';
    Dec(StrLen);
    if StrLen > 0 then
    begin
    Indx[2] := StrToInt(Copy(Str1, StrLen, 1));
    if (Indx[2] <> 0) then
    if (TmpArray[0] <> '') then
    TmpArray[1] := SecondArray[Indx[2], Ord(not Sex)] {}
    else
    TmpArray[1] := SecondArray[Indx[2], Ord(Sex)];
    end;
    if (Indx[2] > 1) and (TmpArray[0] <> '') then
    TmpArray[0] := TmpArray[0] + 'و '
    else if (Indx[1] = 1) and (Indx[2] = 1) then
    TmpArray[0] := FirstArray1[1, Ord(Sex)]
    else if (Indx[1] = 2) and (Indx[2] = 1) then
    TmpArray[0] := FirstArray1[2, Ord(Sex)];
    Dec(StrLen);
    if StrLen > 0 then
    begin
    Indx[3] := StrToInt(Copy(Str1, StrLen, 1));
    if (Indx[3] <> 0) then
    TmpArray[2] := ThirdArray[Indx[3]];
    end;
    if Index = -1 then
    if (Indx[3] <> -1) then
    Exit;
    if (Indx[3] > 0) and ((TmpArray[0] <> '') or (TmpArray[1] <> '')) then
    TmpArray[2] := TmpArray[2] + ' و ';
    case Index of
    -1:
    begin
    TmpStr := TmpArray[2] + TmpArray[0] + TmpArray[1];
    if (Indx[1] > 0) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := SecondArray[Indx[1], Ord(Sex)]
    else
    Result := TmpStr;
    end;
    0:
    begin
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1];
    end;
    1:
    begin
    if (Indx[1] = 1) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := ' ألف'
    else if (Indx[1] = 2) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := 'ألفان'
    else if (Indx[1] > 2) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := TmpArray[0] + ' ألاف'
    else if (Indx[1] > 2) and (Indx[2] = 0) and (Indx[3] <> -1) then
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + ' ألاف'
    else if (Indx[1] = 0) and (Indx[2] = 1) and (Indx[3] = -1) then
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + ' ألاف'
    else if (Indx[1] = 0) and (Indx[2] = 0) and (Indx[3] = 0) then
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1]
    else
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + ' ألف';
    end;
    2:
    begin
    if (Indx[1] = 1) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := ' مليون'
    else if (Indx[1] = 2) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := 'مليونان'
    else if (Indx[1] > 2) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := TmpArray[0] + 'ملايين'
    else if (Indx[1] > 2) and (Indx[2] = 0) and (Indx[3] <> -1) then
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + 'ملايين'
    else if (Indx[1] = 0) and (Indx[2] = 1) and (Indx[3] = -1) then
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + 'ملايين'
    else if (Indx[1] = 0) and (Indx[2] = 0) and (Indx[3] = 0) then
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1]
    else
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + ' مليون';
    end;
    3:
    begin
    if (Indx[1] = 1) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := ' مليار'
    else if (Indx[1] = 2) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := 'ملياران'
    else if (Indx[1] > 2) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := TmpArray[0] + 'مليارات'
    else if (Indx[1] > 2) and (Indx[2] = -1) and (Indx[3] = -1) then
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + 'مليارات'
    else if (Indx[1] = 0) and (Indx[2] = 1) and (Indx[3] = -1) then
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + 'مليارات'
    else
    Result := TmpArray[2] + TmpArray[0] + TmpArray[1] + ' مليار';
    end;
    end;
    end;
    function GetArabicSimpleFigure(const StrNumber: string; Sex: Boolean; var ResultStr: string; const CurName: string): Boolean;
    var
    Parts: array[0..4] of string;
    PartStr: array[0..3] of string;
    Txt, Str, EndStr: string;
    i, StrLength: integer;
    begin
    Result := True;
    Txt := '';
    i := -1;
    if StrNumber = '0' then
    begin
    ResultStr := ' صفر';
    Exit;
    end;
    if StrNumber = '' then
    begin
    ResultStr := '';
    Exit;
    end;
    Str := Trim(StrNumber);
    StrLength := Length(StrNumber);
    Parts[0] := Str;
    while StrLength >= 3 do
    begin
    StrLength := StrLength - 3;
    i := i + 1;
    Parts[i] := Copy(Str, StrLength + 1, 3);
    Str := Copy(Str, 1, StrLength)
    end;
    Parts[i + 1] := Str;
    for i := 0 to 3 do
    if Length(Parts[i]) > 0 then
    PartStr[i] := GetNum(Parts[i], Sex, i);
    for i := 3 downto 0 do
    if Length(PartStr[i]) > 0 then
    if (i <> 0) and (Length(PartStr[i - 1]) > 0) then
    EndStr := EndStr + ' ' + PartStr[i] + ' و '
    else
    EndStr := EndStr + ' ' + PartStr[i] + ' ' + CurName;
    ResultStr := Trim(EndStr);
    ResultStr := NoDoubleSpace(ResultStr);
    end;
    function ArabicSimpleFigure(const StrNumber: string; Sex: Boolean; var ResultStr: string; const CurName, CurPartName: string;CurPartLength:Integer): Boolean;
    var
    AfterPoint,BeforePoint,S:string;
    L,P:Integer;
    begin
    p := Pos('.', StrNumber);
    if p > 0 then
    begin
    AfterPoint := Copy(StrNumber, P+1, CurPartLength);
    if AfterPoint<>'' then
    begin
    L:=CurPartLength-Length(AfterPoint);
    if L>0 then
    AfterPoint:=AfterPoint+StringOfChar('0',L);
    AfterPoint:=FloatToStr(StrToFloat(AfterPoint));
    end;
    BeforePoint := Copy(StrNumber, 0, P-1);
    end
    else
    BeforePoint := StrNumber;
    Result:=GetArabicSimpleFigure(BeforePoint,Sex,S,CurName);
    ResultStr:=S;
    if (AfterPoint <> '') then
    begin
    GetArabicSimpleFigure(AfterPoint,Sex,S,CurPartName);
    ResultStr := ResultStr + ' و ' + s;
    end;
    end;
    end.


    _________________

      الوقت/التاريخ الآن هو 2016-12-09, 10:36