تفقيط الوقت

**محمود أبوسيف** · ديسمبر 13, 2020

السلام عليكم هل ممكن المساعدة في عمل دالة تفقيط الوقت بالساعات والدقائق

يعني مثلا لو أدخلت وقت ٢.٣٠ يظهر ساعتان ونصف وهكذا

Hawiii · ديسمبر 15, 2020

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

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

موفق.

**محمود أبوسيف** · ديسمبر 15, 2020

أخي الكريم أستأذنك في مثال عملي علي ملف من حضرتك

**الجموعي** · ديسمبر 16, 2020

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

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

**ابو جودي** · ديسمبر 16, 2020

في 16‏/12‏/2020 at 19:06, الجموعي 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

Expand

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

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

**الجموعي** · ديسمبر 16, 2020

في 16‏/12‏/2020 at 19:14, ابا جودى said:

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

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

Expand

تفضل أستاذ

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

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

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

دالة تفقيط الوقت.xlsFetching info...

**محمود أبوسيف** · ديسمبر 20, 2020

أخي الكريم جهد رائع ولكن كيف يمكن استخدام مثل هذه الدوال في الأكسس ( يرجي شرح الطريقة علي ملف أكسس )

**ابو جودي** · ديسمبر 21, 2020

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

Test TimeToLettre.mdbFetching info...

Hawiii · يناير 1, 2021

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

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

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

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

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

في 1‏/1‏/2021 at 18:41, Hawiii said:

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

Expand

تم تعديل يناير 1, 2021 بواسطه jjafferr

Hawiii · يناير 1, 2021

لماذا لا يمكنني التعديل على المشاركة السابقة؟!

عموما هناك خطأ كتابي:
فالسطر If hh = 1 Or 2 Then
يعدل إلى If hh = 1 Or hh = 2 Then

وهكذا للدقائق وللثواني

**ابو جودي** · يناير 1, 2021

يا سلام لو تتكرم علينا بمثال عملى

والله كان هيكون اسهل لينا وليك انا كده مش فاهم .. معلش فهمى على ادى

Hawiii · يناير 1, 2021

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

Hawiii · يناير 1, 2021

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

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

**ابو جودي** · يناير 1, 2021

في 1‏/1‏/2021 at 20:31, Hawiii said:

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

Expand

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

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

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

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

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

Hawiii · يناير 1, 2021

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

Test TimeToLettre2.mdbFetching info...

**ابو جودي** · يناير 1, 2021

في 1‏/1‏/2021 at 23:04, Hawiii said:

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

Test TimeToLettre2.mdb 396 kB · 0 downloads

Expand

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

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

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

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

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

تم تعديل يناير 1, 2021 بواسطه ابا جودى

Hawiii · يناير 2, 2021

في 1‏/1‏/2021 at 23:12, ابا جودى said:

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

Expand

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

تسجيل الدخول

تفقيط الوقت

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

محمود أبوسيف

Hawiii

محمود أبوسيف

الجموعي

ابو جودي

الجموعي

محمود أبوسيف

ابو جودي

Hawiii

Hawiii

ابو جودي

Hawiii

Hawiii

ابو جودي

Hawiii

ابو جودي

Hawiii

Join the conversation

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

تصفح الموقع

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

Support

Important Information