الارقام في التقرير

**بلال اليامين** · يوليو 5, 2023

تعديل ارقام التاريخ في التقرير

الارقام.accdb

**jjafferr** · يوليو 5, 2023

السلام عليكم اخي بلال 🙂

رجاء اعطنا معلومات كافية لمعرفة المشكلة ، والحل الذي تريده !!

انا على سبيل المثال ، لا افهم الطلب "على الطاير" مثل ما يقولون ، وانا متأكد بوجود الكثير مثلي ، فساعدنا علشان نساعدك 🙂

ليس في هذا الموضوع فقط ، وانما في جميع مواضيعك لوسمحت 🙂

جعفر

**بلال اليامين** · يوليو 5, 2023

image.png.ce23570ed9c86905bb6300189c037579.png

تم تعديل يوليو 5, 2023 بواسطه بلال اليامين

**jjafferr** · يوليو 7, 2023

السلام عليكم

في دوال التغيير ، لا تعمل لها تنسيق عن طريق الامر Format ، فعندها يتحول متغير التاريخ الى نص ، والسبب هو انك قد تحتاج الى استعمال هذه الدالة مرة اخرى بتنسيق آخر. لذا قم بعمل التنسيق بعد جلب البيانات من الدالة.

وامر CDate ليس مضمونا ان يحول النص الى تاريخ ، والامر الاصح هو DateSerial ، حتى لا يختلط الشهر باليوم .

هكذا اصبحت دالة ToHijri :

Option Compare Database
Option Explicit

Private CorctAdjustDay As Integer
Private SavedCal As Integer
Private d As Date
Private s As String



'التحويل من التاريخ الميلادى للهجرى
Public Function ToHijri(ByRef myData As String)
  
  'إحضار القيمة العددية لفرق الأيام من جدول إعداد ضبط التاريخ الهجرى
  CorctAdjustDay = DLookup("[AdjustDay]", "tblAdjustHjriDate")
      
      'ضبط التاريخ الميلادى بالزيادة أوالنقصان
      'حسب القيمة العددية والتى تساوى التاريخ الهجرى
      'myData = Trim(Format(DateAdd("d", CorctAdjustDay, myData), "dd/mm/yyyy"))
      myData = Trim(DateAdd("d", CorctAdjustDay, myData))
  
  'التحويل من التاريخ الميلادى للهجرى
  SavedCal = Calendar
  VBA.Calendar = 0
  'd = CDate(myData)
  d = myData
  
  'Hijri
  VBA.Calendar = 1
  s = CStr(d)
  'ToHijri = Format(s, "dd/mm/yyyy")
  ToHijri = s
  VBA.Calendar = SavedCal

'يتم استدعاء الموديول بالشكل التالى
'txt Hijri date = ToHijri(txt Milady date)
End Function

.

وهكذا نناديها (لاحظ التنسيق يتم بعد مناداة الدالة) ، وهنا استخدم جدول tbl_Months لنحصل على الاسماء باللغة العربية :

Private Sub Report_Load()
On Error Resume Next
DoCmd.ShowToolbar "Ribbon", acToolbarNo


    Dim Arabic_Month As String

'Georgian
    Arabic_Month = DLookup("[Months_Georgian]", "tbl_Months", "[Months_English]='" & Format(Date, "mmmm") & "'")
    Me.H_TEXT = ConArNum(Format(Date, "dd ")) & _
                 Arabic_Month & _
                  ConArNum(Format(Date, " yyyy م"))

'Hijri
    Me.txtHijriDate = ToHijri(Date)
    Arabic_Month = DLookup("[Months_Hijri]", "tbl_Months", "[Months_Number]=" & Month(Me.txtHijriDate))

    Me.txtHijriDate = ConArNum(Format(Me.txtHijriDate, "dd ")) & _
                       Arabic_Month & _
                        ConArNum(Format(Me.txtHijriDate, " yyyy هـ"))
    
End Sub

.

الدالة ConArNum هي لتحويل الارقام العربية الى ارقام هندية (نعم الارقام التي نستخدمها هي ارقام هندية) :

Public Function ConArNum(ByVal strStringToConvert As String) As String

'
'https://www.vbforums.com/showthread.php?584388-Arabic-Numbers-display-on-one-machine-but-not-another&p=3609151&viewfull=1#post3609151
'
' Convert the Arabic number to Indian
'

On Error GoTo ErrorHandler

strStringToConvert = Replace$(strStringToConvert, "0", ChrW$(1632))
strStringToConvert = Replace$(strStringToConvert, "1", ChrW$(1633))
strStringToConvert = Replace$(strStringToConvert, "2", ChrW$(1634))
strStringToConvert = Replace$(strStringToConvert, "3", ChrW$(1635))
strStringToConvert = Replace$(strStringToConvert, "4", ChrW$(1636))
strStringToConvert = Replace$(strStringToConvert, "5", ChrW$(1637))
strStringToConvert = Replace$(strStringToConvert, "6", ChrW$(1638))
strStringToConvert = Replace$(strStringToConvert, "7", ChrW$(1639))
strStringToConvert = Replace$(strStringToConvert, "8", ChrW$(1640))
strStringToConvert = Replace$(strStringToConvert, "9", ChrW$(1641))

ConArNum = strStringToConvert

Exit Function
ErrorHandler:
ConArNum = vbNullString

End Function