اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

تفقيط الوقت


الردود الموصى بها

فقط حول الوقت إلى ساعات ودقائق باستخدام دالتي Hour و Minute
ثم عاملهم كعملة بنفس دالة التفقيط التي لديك أو ابحث عنها في المنتدى
وعرف الساعات بـ ساعة للمفرد وساعاتان للمثنى و ساعات للجمع وجنسها مؤنث
وعرف الدقائق بـ دقيقة للمقرد ودقيقتان للمثنى ودقائق للجمع وجنسها مؤنث أيضا

يبقى عملية تحويل الدقائق إلى تفقيط كسور يمكن عملها بسهولة والشباب ما رايح يقصرون معك مع أن أرى أن لا داعي لها
وستستخدمها مع 15 ، 20 ، 30 و 45 دقيقة.

موفق.

رابط هذا التعليق
شارك

إليك الدالة المعرفة

TimeToLettre
الدالة تعمل إلى غاية 
"99:99:99"
وتعمل للساعات فقط أو الدقائق  فقط أو الثواني فقط
Function TimeToLettre(Time As Variant) As String
' Created By Benkhalifa Djemoui
' Algeria: 05-12-2020
Dim MyHour As Variant
Dim MyMinute As Variant
Dim MM, HH, SS As String
Dim H, M, S As Byte
'===============================================================================================================================
MyHour = Array("", "ساعة", "ساعتان")
'===============================================================================================================================
MyMinute = Array("صفر", "دقيقة", "دقيقتان", "ثلاث", "أربع", "خمس", "ست", "سبع", "ثمان", "تسع", _
"عشر", "إحدى عشر", "إثنى عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", "تسعة عشر", _
"عشرون", "واحد و عشرون", "إثنان و عشرون", "ثلاثة و عشرون", "أربعة و عشرون", "خمسة و عشرون", "ستة و عشرون", _
"سبعة و عشرون", "ثمانية و عشرون", "تسعة عشرون", _
"ثلاثون", "واحد و ثلاثون", "إثنان و ثلاثون", "ثلاثة و ثلاثون", "أربعة و ثلاثون", _
"خمسة و ثلاثون", "ستة و ثلاثون", "سبعة و ثلاثون", "ثمانية و ثلاثون", "تسعة و ثلاثون", _
"أربعون", "واحد و أربعون", "إثنان و أربعون", "ثلاثة و أربعون", "أربعة و أربعون", "خمسة و أربعون", "ستة و أربعون", _
"سبعة و أربعون", "ثمانية و أربعون", "تسعة و أربعون", _
"خمسون", "واحد و خمسون", "إثنان و خمسون", "ثلاثة و خمسون", "أربعة و خمسون", _
"خمسة و خمسون", "ستة و خمسون", "سبعة و خمسون", "ثمانية و خمسون", "تسعة و خمسون", _
"ستون", "واحد و ستون", "إثنان و ستون", "ثلاثة و ستون", "أربعة و ستون", _
"خمسة و ستون", "ستة و ستون", "سبعة و ستون", "ثمانية و ستون", "تسعة و ستون", _
"سبعون", "واحد و سبعون", "إثنان و سبعون", "ثلاثة و سبعون", "أربعة و سبعون", _
"خمسة و سبعون", "ستة و سبعون", "سبعة و سبعون", "ثمانية و سبعون", "تسعة و سبعون", _
"ثمانون", "واحد و ثمانون", "إثنان و ثمانون", "ثلاثة و ثمانون", "أربعة و ثمانون", _
"خمسة و ثمانون", "ستة و ثمانون", "سبعة و ثمانون", "ثمانية و ثمانون", "تسعة و ثمانون", _
"تسعون", "واحد و تسعون", "إثنان و تسعون", "ثلاثة و تسعون", "أربعة و تسعون", _
"خمسة و تسعون", "ستة و تسعون", "سبعة و تسعون", "ثمانية و تسعون", "تسعة و تسعون")
'===============================================================================================================================
Time = Split(Time, ":")
H = Int(Time(0))
M = Int(Time(1))
S = Int(Time(2))
'===============================================================================================================================
If H = 0 Then GoTo Minute
Select Case H
Case 1 To 2: Select Case M: Case 0: HH = MyHour(H): Case Else: HH = MyHour(H) & "  و ": End Select
Case 3 To 10: Select Case M: Case 0: HH = MyMinute(H) & " ساعات ": Case Else: HH = MyMinute(H) & " ساعات و": End Select
Case 11 To 99: Select Case M: Case 0: HH = MyMinute(H) & " ساعة ": Case Else: HH = MyMinute(H) & " ساعة و ": End Select
End Select
'===============================================================================================================================
Minute:
If M = 0 Then GoTo Second
If M <> 15 And M <> 30 Then
Select Case M
Case 1:        Select Case S: Case 0: MM = MyMinute(M): Case Else: MM = MyMinute(M) & " و": End Select
Case 2:        Select Case S: Case 0: MM = MyMinute(M): Case Else: MM = MyMinute(M) & " و": End Select
Case 3 To 10:  Select Case S: Case 0: MM = MyMinute(M) & " دقائق ": Case Else: MM = MyMinute(M) & " دقائق و ": End Select
Case 11 To 59: Select Case S: Case 0: MM = MyMinute(M) & " دقيقة ": Case Else: MM = MyMinute(M) & " دقيقة و ": End Select
End Select
'===============================================================================================================================
Else
If H <> 0 Then
Select Case M
Case 15: Select Case S: Case 0: MM = " ربع  ": Case Else: MM = " ربع و ": End Select
Case 30: Select Case S: Case 0: MM = " نصف  ": Case Else: MM = " نصف و ": End Select
End Select
Else
Select Case M
Case 15: Select Case S: Case 0: MM = " ربع ساعة ": Case Else: MM = " ربع و ": End Select
Case 30: Select Case S: Case 0: MM = " نصف ساعة ": Case Else: MM = " نصف و ": End Select
End Select
End If
End If
'===============================================================================================================================
Second:
If H <> 0 Or M <> 0 Then
Select Case S
Case 1:        Select Case M: Case 0: SS = " و ثانية": Case Else: SS = " ثانية": End Select
Case 2:        Select Case M: Case 0: SS = " و ثانيتان": Case Else: SS = " ثانيتان": End Select
Case 3 To 10:  Select Case M: Case 0: SS = " و " & MyMinute(S) & " ثوان": Case Else: SS = MyMinute(S) & " ثوان": End Select
Case 11 To 59: Select Case M: Case 0: SS = " و " & MyMinute(S) & " ثانية": Case Else: SS = MyMinute(S) & " ثانية": End Select
End Select
'===============================================================================================================================
Else
Select Case S
Case 1:  SS = "ثانية"
Case 2:  SS = "ثانيتان"
Case 3 To 10: SS = MyMinute(S) & " ثوان"
Case 4 To 59: SS = MyMinute(S) & " ثانية"
End Select
End If
'===============================================================================================================================
TimeToLettre = Trim(HH) & " " & Trim(MM) & " " & Trim(SS)
'===============================================================================================================================
Erase MyHour, MyMinute
End Function

 

2020-12-16_19-48-58.png.d3254be117efebc932da12c9cf28724e.png

  • Like 3
  • Thanks 1
رابط هذا التعليق
شارك

6 دقائق مضت, الجموعي said:

إليك الدالة المعرفة


TimeToLettre

 


Function TimeToLettre(Time As Variant) As String
' Created By Benkhalifa Djemoui
' Algeria: 05-12-2020
Dim MyHour As Variant
Dim MyMinute As Variant
Dim MM, HH, SS As String
Dim H, M, S As Byte
'===============================================================================================================================
MyHour = Array("", "ساعة", "ساعتان")
'===============================================================================================================================
MyMinute = Array("صفر", "دقيقة", "دقيقتان", "ثلاث", "أربع", "خمس", "ست", "سبع", "ثمان", "تسع", _
"عشر", "إحدى عشر", "إثنى عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", "تسعة عشر", _
"عشرون", "واحد و عشرون", "إثنان و عشرون", "ثلاثة و عشرون", "أربعة و عشرون", "خمسة و عشرون", "ستة و عشرون", _
"سبعة و عشرون", "ثمانية و عشرون", "تسعة عشرون", _
"ثلاثون", "واحد و ثلاثون", "إثنان و ثلاثون", "ثلاثة و ثلاثون", "أربعة و ثلاثون", _
"خمسة و ثلاثون", "ستة و ثلاثون", "سبعة و ثلاثون", "ثمانية و ثلاثون", "تسعة و ثلاثون", _
"أربعون", "واحد و أربعون", "إثنان و أربعون", "ثلاثة و أربعون", "أربعة و أربعون", "خمسة و أربعون", "ستة و أربعون", _
"سبعة و أربعون", "ثمانية و أربعون", "تسعة و أربعون", _
"خمسون", "واحد و خمسون", "إثنان و خمسون", "ثلاثة و خمسون", "أربعة و خمسون", _
"خمسة و خمسون", "ستة و خمسون", "سبعة و خمسون", "ثمانية و خمسون", "تسعة و خمسون", _
"ستون", "واحد و ستون", "إثنان و ستون", "ثلاثة و ستون", "أربعة و ستون", _
"خمسة و ستون", "ستة و ستون", "سبعة و ستون", "ثمانية و ستون", "تسعة و ستون", _
"سبعون", "واحد و سبعون", "إثنان و سبعون", "ثلاثة و سبعون", "أربعة و سبعون", _
"خمسة و سبعون", "ستة و سبعون", "سبعة و سبعون", "ثمانية و سبعون", "تسعة و سبعون", _
"ثمانون", "واحد و ثمانون", "إثنان و ثمانون", "ثلاثة و ثمانون", "أربعة و ثمانون", _
"خمسة و ثمانون", "ستة و ثمانون", "سبعة و ثمانون", "ثمانية و ثمانون", "تسعة و ثمانون", _
"تسعون", "واحد و تسعون", "إثنان و تسعون", "ثلاثة و تسعون", "أربعة و تسعون", _
"خمسة و تسعون", "ستة و تسعون", "سبعة و تسعون", "ثمانية و تسعون", "تسعة و تسعون")
'===============================================================================================================================
Time = Split(Time, ":")
H = Int(Time(0))
M = Int(Time(1))
S = Int(Time(2))
'===============================================================================================================================
If H = 0 Then GoTo Minute
Select Case H
Case 1 To 2: Select Case M: Case 0: HH = MyHour(H): Case Else: HH = MyHour(H) & "  و ": End Select
Case 3 To 10: Select Case M: Case 0: HH = MyMinute(H) & " ساعات ": Case Else: HH = MyMinute(H) & " ساعات و": End Select
Case 11 To 99: Select Case M: Case 0: HH = MyMinute(H) & " ساعة ": Case Else: HH = MyMinute(H) & " ساعة و ": End Select
End Select
'===============================================================================================================================
Minute:
If M = 0 Then GoTo Second
If M <> 15 And M <> 30 Then
Select Case M
Case 1:        Select Case S: Case 0: MM = MyMinute(M): Case Else: MM = MyMinute(M) & " و": End Select
Case 2:        Select Case S: Case 0: MM = MyMinute(M): Case Else: MM = MyMinute(M) & " و": End Select
Case 3 To 10:  Select Case S: Case 0: MM = MyMinute(M) & " دقائق ": Case Else: MM = MyMinute(M) & " دقائق و ": End Select
Case 11 To 59: Select Case S: Case 0: MM = MyMinute(M) & " دقيقة ": Case Else: MM = MyMinute(M) & " دقيقة و ": End Select
End Select
'===============================================================================================================================
Else
If H <> 0 Then
Select Case M
Case 15: Select Case S: Case 0: MM = " ربع  ": Case Else: MM = " ربع و ": End Select
Case 30: Select Case S: Case 0: MM = " نصف  ": Case Else: MM = " نصف و ": End Select
End Select
Else
Select Case M
Case 15: Select Case S: Case 0: MM = " ربع ساعة ": Case Else: MM = " ربع و ": End Select
Case 30: Select Case S: Case 0: MM = " نصف ساعة ": Case Else: MM = " نصف و ": End Select
End Select
End If
End If
'===============================================================================================================================
Second:
If H <> 0 Or M <> 0 Then
Select Case S
Case 1:        Select Case M: Case 0: SS = " و ثانية": Case Else: SS = " ثانية": End Select
Case 2:        Select Case M: Case 0: SS = " و ثانيتان": Case Else: SS = " ثانيتان": End Select
Case 3 To 10:  Select Case M: Case 0: SS = " و " & MyMinute(S) & " ثوان": Case Else: SS = MyMinute(S) & " ثوان": End Select
Case 11 To 59: Select Case M: Case 0: SS = " و " & MyMinute(S) & " ثانية": Case Else: SS = MyMinute(S) & " ثانية": End Select
End Select
'===============================================================================================================================
Else
Select Case S
Case 1:  SS = "ثانية"
Case 2:  SS = "ثانيتان"
Case 3 To 10: SS = MyMinute(S) & " ثوان"
Case 4 To 59: SS = MyMinute(S) & " ثانية"
End Select
End If
'===============================================================================================================================
TimeToLettre = Trim(HH) & " " & Trim(MM) & " " & Trim(SS)
'===============================================================================================================================
Erase MyHour, MyMinute
End Function

 

2020-12-16_19-48-58.png.d3254be117efebc932da12c9cf28724e.png

رائع ما شاء الله تسلم ايدك :fff::fff::clapping:

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

رابط هذا التعليق
شارك

8 دقائق مضت, ابا جودى said:

رائع ما شاء الله تسلم ايدك :fff::fff::clapping:

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

تفضل أستاذ

في المثال دالتان معرفتان

الدالة الأولى لتفقيط الوقت 

الدالة الثانية لتفقيط  مجموع الوقت 

دالة تفقيط الوقت.xls

  • Like 3
  • Thanks 2
رابط هذا التعليق
شارك

اتفضل نفس الأكواد التى تفضل بها الاستاذ الكريم @الجموعي جزاه الله خيـــر مع بعض التعديلات التى تماسب طلبك تماما

Test TimeToLettre.mdb

  • Like 1
رابط هذا التعليق
شارك

  • 2 weeks later...

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

يرجى الانتباه أن هناك قلب في بعض القيم المكتوبة بالعربي عند لصقها هنا.

 

--------------------

ملاحظة فريق الموقع:

تم حذف الكود حسب طلب صاحب المشاركة :

منذ ساعه, Hawiii said:

أولا: آمل من المشرف حذف الكود أعلاه لوجود أكثر من خطأ فيه.
ثانيا: مصدر دالة أبو هادي https://www.officena.net/ib/topic/315-تفقيط-عربي-انجليزي-محدث/?do=findComment&comment=56740
ثالثا: مثال مرفق حسب السيد @ابا جودى
رابعا: المثال عبارة عن كود في الوحدة النمطة Time2Text

تم تعديل بواسطه jjafferr
رابط هذا التعليق
شارك

أولا: آمل من المشرف حذف الكود أعلاه لوجود أكثر من خطأ فيه.
ثانيا: مصدر دالة أبو هادي https://www.officena.net/ib/topic/315-تفقيط-عربي-انجليزي-محدث/?do=findComment&comment=56740
ثالثا: مثال مرفق حسب السيد @ابا جودى
رابعا: المثال عبارة عن كود في الوحدة النمطة Time2Text
Time2Text_20200101.accdb

رابط هذا التعليق
شارك

الدالة بعد التعديل:
 

Option Explicit

Function Time2Text(ByVal inTimeOrHours As Variant, _
          Optional ByVal IgnoreConfirm = True) As String
  'Hawiii الكاتب هاوي
  '01/01/2021
  'لتفقيط الوقت اعتمادا على دالة أبو هادي للتفقيط العربي
  'ArbNum2Text()
  'أي لا بد من وجود الدالة الأصل لتعمل هذه الدالة
  'المدخل إما بتنسيق تاريخ أو رقم
  
  Dim inVal As Variant
  Dim hh As Integer
  Dim nn As Byte
  Dim ss As Byte
  Dim hhh As String
  Dim nnn As String
  Dim sss As String
  Dim Res As String
  Dim Spp As Byte
  
  Time2Text = ""
  inVal = myNz(inTimeOrHours, "")
  If Not IsDate(inVal) And Not IsNumeric(inVal) Then Exit Function
  
  If IsDate(inVal) Then
    inVal = CDate(Format(inVal, "hh:mm:ss")) * 24
  Else
    inVal = CDbl(inVal)
  End If
   
  hh = Fix(inVal):           inVal = (inVal - hh) * 60
  nn = Fix(inVal + 0.00001): inVal = (inVal - nn) * 60
  ss = Round(inVal, 0): If ss = 60 Then ss = 59
  
  hhh = IIf(hh = 0, "", ArbNum2Text(hh, , , "ساعة", "ساعات", vFemale))
  sss = IIf(ss = 0, "", ArbNum2Text(ss, , , "ثانية", "ثوان", vFemale))
  Select Case nn
    Case 0:  nnn = ""
    Case 15: nnn = "ربع"
    Case 20: nnn = "ثلث"
    Case 30: nnn = "نصف"
    Case 45: nnn = "ثلاثة أرباع"
    Case Else
      nnn = ArbNum2Text(nn, , , "دقيقة", "دقائق", vFemale)
  End Select
  nnn = nnn & IIf(hh = 0, IIf(nn = 45, " الساعة", " ساعة"), "")
  
  If IgnoreConfirm Then
    If hh = 1 Or hh = 2 Then
      Spp = InStrRev(hhh, " ", -1): hhh = Left(hhh, Spp - 1)
    End If
    If nn = 1 Or nn = 2 Then
      Spp = InStrRev(nnn, " ", -1): nnn = Left(nnn, Spp - 1)
    End If
    If ss = 1 Or ss = 2 Then
      Spp = InStrRev(sss, " ", -1): sss = Left(sss, Spp - 1)
    End If
    
  End If
  
  Res = hhh
  Res = Res & IIf(Res = "", nnn, IIf(nnn = "", "", " و" & nnn))
  Res = Res & IIf(Res = "", sss, IIf(sss = "", "", " و" & sss))
  
  Time2Text = Res
End Function

Sub Test4Time2Text()
  Debug.Print Time2Text("00:15:00")
  Debug.Print Time2Text("00:30:00")
  Debug.Print Time2Text("01:15:00")
  Debug.Print Time2Text("02:30:00")
  Debug.Print Time2Text("15:15:02")
  Debug.Print Time2Text("16:01:00")
  Debug.Print Time2Text("22:02:00")
  Debug.Print Time2Text("23:09:59")
  Debug.Print Time2Text(24.5 + 1 / 3600)
  Debug.Print Time2Text(99 + 59 / 60 + 12 / 3600)
End Sub

 

رابط هذا التعليق
شارك

21 دقائق مضت, Hawiii said:

الدالة بعد التعديل:

وكيف يتم استدعاؤها داخل الاستعلام

اكمل جميلك واتمم المرفق بارك الله فيك 

ان كان المرفق يحتوى فقط على اكواد الموديول فقد قمت حضرتك بوضعها مسبقا ولم استطع فهم شئ 

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

شكرا مسبقا لحضرتك وكرم اخلاقك استاذى

رابط هذا التعليق
شارك

9 دقائق مضت, Hawiii said:

يا عم @ابا جودى قبل مشاركة الكود هتاك مشاركة بها مثال أكسس
مرفق مثالك بعد إضافة دالتي.

Test TimeToLettre2.mdb 396 kB · 0 downloads

اولا بعد جزاكم الله خيـــرا :wub: انا اسف تعبت حضرتك

كل الشكر والتقدير لحضرتك :fff:

للعلم المرفق السابق الذى يحتوى على التعليمات البرمجية فقط داخل الموديول لا يعمل :yes:

الان صار كل شئ تمام تسلم ايدك

لو استطيع لوضعت تلك المشاركة افضل إجابة

تم تعديل بواسطه ابا جودى
رابط هذا التعليق
شارك

8 ساعات مضت, ابا جودى said:

للعلم المرفق السابق الذى يحتوى على التعليمات البرمجية فقط داخل الموديول لا يعمل :yes:

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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information