البحث في الموقع

السلام عليكم ورحمة الله تعالى وبركاته الموضوع اخذ وقت وجهد شديدين ان شاء الله ينال رضاكم واقدمه ابتغاء وجه الله تعالى ليكون هدية قمية فى مكتباتكم وقواعد بياناتكم فى اعمالكم ان شاء الله اولا وبادئ ذى بدئ لابد أن أتقدم باخالص الشكر والتقدير والعرفان بالجميل لمن تحملوا إثقالى عليهم مرارا وتكرار دون كلل أو ملل حتى يخرج هذا العمل فى أبهى صورة وبهذا الشكل معلمى القدير وأستاذى الجليل و والدى الحبيب الأستاذ @ابوخليل أول يد امتدت إلى فى هذا الصرح الشامخ فتحمل جهلى دائما بحلم ودوما يصحح لى أخطائى بعلم فجزاه الله تعالى عنى وعن كل طلاب العلم كل الخير وحتى لا أضيع فضل أحد الأساتذة العظماء أو ينسينى الشيطان ذكر ـى من العظماء الكرام الذين نتعلم منهم جمبعا فى هذا الصرح الشامخ الذى هو بمثابة ينابيع العلوم والمعرفة وبساتين الأفكار التى نطوف بهم فنرتشف من كل ينبوع قطرة ونأخذ من كل بستان زهرة جزا الله كل أصحاب الفضل علينا والذين نتعلم على اياديهم المباركة وشكر الله لكم حسن صنيعكم معنا و تحملكم لنا . صاحب المكتبة العامرة سيادة المستشار المؤتمن ... والله اشتقنا الاستاذ @Moosak اقول له جرب وقول لى رايك يجرب ويطلع عينى بجد تعب معايا بس عرفت من تجاربه حجات مكنتش اعرفها والله على سبيل المثال المنازل العشرية المختلفة للعملات والاسماء الذكورية والانثوية بصراحة لم انتبه اليها كان كل همى الكود وترتيب الافكار لكن نعمل ايه ادى اخرة اللى يصاحب اخ بالشكل ده يطلع عينه🤣 أدامكم الله أرواح طيبة تسكن القلوب .. ووجوه باسمة ترتاح لها العيون .. وأنفس مطمئنة دائما وابدا تمتلك النفوس .. وأسأله عز وجل أن يعطيكم من عطــاياه ويمنحكم عفوه ورضاه ويغفر لكم من عمركم ما مضى ويقدر لكم الخير فيما أتى .. وأن يجعل السعادة رفيقتكم في الدنيا والآخره.. اللهم آمين ------------------------------------------- الموضوع متعب جدا الاكواد كثيرة ومن أجل ذلم يمكن النقاش فيها ان اردتم وسوف يتم الرد على قدر السؤال لان فعلا الاكواد ليست قليلة وكم الافكار بها ليس بالهين ولكن ان شاء الله سوف تتناولها سريعا ونأخذ عنها فكرة . اولا الاكواد داخل الوحدة النمطية اجمالا Option Compare Database Option Explicit '********************************************************************** ' Function: ConvertCurrencyToWords ' Purpose: Converts a numeric value to its word representation based on the specified options. ' Inputs: ' Number - The numeric value to be converted (Variant). ' Optional CurrencyType - A string specifying the type of currency (default is ""). ' Optional language - The language for the conversion, e.g., "ar" for Arabic or "en" for English (default is "ar"). ' Optional ShowExtras - A Boolean flag indicating whether to include additional details (default is True). ' Returns: String - The numeric value converted to words, based on the provided parameters. ' Notes: ' - The function handles both integer and fractional parts of the number. ' - The `CurrencyType` parameter can be used to specify different types of currencies for more precise conversion. ' - The `language` parameter controls the language in which the number is converted to words. ' - The `ShowExtras` parameter determines if additional information such as currency symbols or other text should be included. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** ' Example usages: ' 1. ConvertCurrencyToWords(Number) ' - Converts the provided numeric value to Currency words in the default language (Arabic) with additional details. ' - Example: ConvertNumberToWords(123.45) . ' 2. ConvertCurrencyToWords(Number, "Currency Type") ' - Converts the provided numeric value to words in the default language (Arabic) and specifies the currency type as USD. ' - Example: ConvertCurrencyToWords(123.45, "Currency Type"). ' 3. ConvertCurrencyToWords(Number, "", "en") ' - Converts the provided numeric value to words in English and includes additional Currency details. ' - Example: ConvertCurrencyToWords(123.45, "", "en"). ' 4. ConvertNumberToWords(Number) ' - Converts the provided numeric value to words in Arabic but excludes additional Currency details. ' - Example: ConvertCurrencyToWords(123.45,"en"). ' 5. ConvertNumberToWords(Number, "", "en", False) ' - Converts the provided numeric value to words in English but excludes additional Currency details. ' - Example: ConvertCurrencyToWords(123.45, "", "en", False) . ' This function is versatile and can be used to convert numbers to words in various languages and formats, depending on the parameters provided. '********************************************************************** '********************************************************************** ' Variable Declarations '********************************************************************** ' Currency Information in Arabic ' Represents the singular name of the currency. Dim CurrencyNameSingular As String ' Represents the dual form of the currency name. Dim CurrencyNameDual As String ' Represents the plural form of the currency name. Dim CurrencyNamePlural As String ' Represents the accusative form of the currency name. Dim CurrencyNameAccusative As String ' Represents the singular form of the fractional unit (e.g., piastre). Dim FractionalUnitSingular As String ' Represents the dual form of the fractional unit. Dim FractionalUnitDual As String ' Represents the plural form of the fractional unit. Dim FractionalUnitPlural As String ' Represents the accusative form of the fractional unit. Dim FractionalUnitAccusative As String ' Currency Information in Other Language ' Represents the singular name of the currency in another language (e.g., English). Dim CurrencyNameSingularOtherLang As String ' Represents the dual form of the currency name in another language. Dim CurrencyNameDualOtherLang As String ' Represents the plural form of the currency name in another language. Dim CurrencyNamePluralOtherLang As String ' Represents the accusative form of the currency name in another language. Dim CurrencyNameAccusativeOtherLang As String ' Represents the singular form of the fractional unit in another language. Dim FractionalUnitSingularOtherLang As String ' Represents the dual form of the fractional unit in another language. Dim FractionalUnitDualOtherLang As String ' Represents the plural form of the fractional unit in another language. Dim FractionalUnitPluralOtherLang As String ' Represents the accusative form of the fractional unit in another language. Dim FractionalUnitAccusativeOtherLang As String ' Represents the base value of the currency. Dim CurrencyBaseValue As Integer ' Represents the base value of the fractional unit. Dim FractionalUnitBaseValue As Integer ' Represents the ISO code for the currency. Dim CurrencyISOCode As String ' Represents the number of decimal places for the currency. Dim NumberOfDecimalPlaces As Integer ' Indicates whether the currency is considered feminine. Dim isCurrencyFeminine As Boolean '********************************************************************** ' Function: CurrencyYouWantToBeActive ' Purpose: Returns the name of the currency that should be set as active. ' Inputs: None. ' Outputs: None. ' Returns: String - The name of the active currency in Arabic (encoded as ASCII characters). ' Notes: - The returned string is encoded using ASCII character codes to represent Arabic text. ' - This function is typically used to identify the currency that should be marked as active in the system. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Public Function CurrencyYouWantToBeActive() CurrencyYouWantToBeActive = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(32) & Chr(211) & Chr(218) & Chr(230) & Chr(207) & Chr(237) End Function '********************************************************************** ' Sub: TestConvertCurrencyToWords ' Purpose: Tests the ConvertCurrencyToWords function by converting various numeric strings to words ' in both Arabic and English. ' Notes: The subroutine uses a set of test numbers, converts each to words in both languages, ' and displays the results using message boxes. ' It also confirms the completion of the test. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Sub TestConvertCurrencyToWords() Dim number As String Dim resultAr As String Dim resultEn As String ' Specify the numbers to be tested. Dim testNumbers As Variant testNumbers = Array("1234.56", "0", "-123.45", "1000000.99", "123456789.12") Dim i As Integer For i = LBound(testNumbers) To UBound(testNumbers) number = testNumbers(i) ' Convert the number to Arabic words resultAr = ConvertCurrencyToWords(number, "ar") MsgBox "Arabic Conversion for " & number & ": " & vbCrLf & resultAr, vbInformation, "Arabic Result" ' Convert the number to English words resultEn = ConvertCurrencyToWords(number, "en") MsgBox "English Conversion for " & number & ": " & vbCrLf & resultEn, vbInformation, "English Result" Next i ' Confirm trial end MsgBox "Conversion tests completed successfully.", vbInformation, "Test Completed" End Sub '********************************************************************** ' Sub: TestGetCurrencyValues ' Purpose: Tests the GetCurrencyValues function by retrieving currency values for both Arabic and English languages. ' Notes: The subroutine retrieves currency values for both languages and prints each value in the Immediate window. ' This helps verify that the function returns the correct values for different languages. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Public Sub TestGetCurrencyValues() Dim currencyValues As Variant Dim i As Integer ' Test for both languages Dim languages As Variant languages = Array("ar", "en") Dim lang As Variant For Each lang In languages ' Call the function and get the result currencyValues = GetCurrencyValues("") ' Print each value in the Immediate Window for debugging purposes Debug.Print "Currency Values for Language: " & lang For i = LBound(currencyValues) To UBound(currencyValues) Debug.Print currencyValues(i) Next i Debug.Print "---------------------------------------" Next lang End Sub '********************************************************************** ' Function: TableExists ' Purpose: Checks whether a table with the specified name exists in the current database. ' Inputs: tableName - A string representing the name of the table to check. ' The table name should be provided as a complete name (e.g., "Customers"). ' Returns: Boolean - Returns True if the table exists in the current database; ' otherwise, returns False. ' Notes: This function utilizes error handling to determine the existence of the table. ' If an error occurs (e.g., table does not exist), the function safely returns False. ' Ensure that the table name is correctly spelled and exists in the current database. ' The function relies on DAO (Data Access Objects) library to interact with the database. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Function TableExists(TableName As String) As Boolean Dim db As DAO.Database Dim tdf As DAO.TableDef ' Obtain a reference to the current database Set db = CurrentDb() ' Initialize error handling On Error Resume Next ' Attempt to set the TableDef object for the specified table Set tdf = db.TableDefs(TableName) ' Determine if the TableDef object was successfully set (table exists) TableExists = Not tdf Is Nothing ' Reset error handling On Error GoTo 0 ' Clean up objects to free memory Set tdf = Nothing Set db = Nothing End Function '********************************************************************** ' Sub: CreateCurrencyTable ' Purpose: Creates a new table named "tblCurrencyInfo" with predefined fields in the current database. ' Inputs: None ' Returns: None ' Notes: This subroutine initializes a new table definition object, defines the necessary fields ' for storing currency information, and appends the table definition to the database. ' The fields include both standard and language-specific currency information. ' After creating the table, it refreshes the database window to reflect the changes. ' Ensure that this table name does not conflict with existing tables in the database. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Sub CreateCurrencyTable() On Error GoTo ErrorHandler Dim db As DAO.Database Dim tdf As DAO.TableDef Dim fld As DAO.Field ' Obtain a reference to the current database Set db = CurrentDb() ' Create a new TableDef object for "tblCurrencyInfo" Set tdf = db.CreateTableDef("tblCurrencyInfo") ' Define the fields for the new table With tdf ' Add fields with names and types .Fields.Append .CreateField("IsCurrencyActive", dbBoolean) .Fields.Append .CreateField("CurrencyNameSingular", dbText) .Fields.Append .CreateField("CurrencyNameDual", dbText) .Fields.Append .CreateField("CurrencyNamePlural", dbText) .Fields.Append .CreateField("CurrencyNameAccusative", dbText) .Fields.Append .CreateField("CurrencyBaseValue", dbInteger) .Fields.Append .CreateField("isCurrencyFeminine", dbBoolean) .Fields.Append .CreateField("NumberOfDecimalPlaces", dbInteger) .Fields.Append .CreateField("FractionalUnitSingular", dbText) .Fields.Append .CreateField("FractionalUnitDual", dbText) .Fields.Append .CreateField("FractionalUnitPlural", dbText) .Fields.Append .CreateField("FractionalUnitAccusative", dbText) .Fields.Append .CreateField("FractionalUnitBaseValue", dbInteger) .Fields.Append .CreateField("CurrencyNameSingularOtherLang", dbText) .Fields.Append .CreateField("CurrencyNameDualOtherLang", dbText) .Fields.Append .CreateField("CurrencyNamePluralOtherLang", dbText) .Fields.Append .CreateField("CurrencyNameAccusativeOtherLang", dbText) .Fields.Append .CreateField("CurrencyBaseValueOtherLang", dbInteger) .Fields.Append .CreateField("FractionalUnitSingularOtherLang", dbText) .Fields.Append .CreateField("FractionalUnitDualOtherLang", dbText) .Fields.Append .CreateField("FractionalUnitPluralOtherLang", dbText) .Fields.Append .CreateField("FractionalUnitAccusativeOtherLang", dbText) .Fields.Append .CreateField("FractionalUnitBaseValueOtherLang", dbInteger) .Fields.Append .CreateField("CurrencyISOCode", dbText) End With ' Append the new table definition to the database db.TableDefs.Append tdf ' Open the table definition to update captions and descriptions Set tdf = db.TableDefs("tblCurrencyInfo") ' Define captions and descriptions for each field Set fld = tdf.Fields("IsCurrencyActive") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(202) & Chr(221) & Chr(218) & Chr(237) & Chr(225) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(202) & Chr(221) & Chr(218) & Chr(237) & Chr(225) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(225) & Chr(199) & Chr(211) & Chr(202) & Chr(206) & Chr(207) & Chr(199) & Chr(227) & Chr(229) & Chr(199) & Chr(32) & Chr(221) & Chr(237) & Chr(32) & Chr(199) & Chr(225) & Chr(202) & Chr(216) & Chr(200) & Chr(237) & Chr(222) & Chr(199) & Chr(202)) Set fld = tdf.Fields("CurrencyNameSingular") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(227) & Chr(221) & Chr(209) & Chr(207) & Chr(41)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(227) & Chr(221) & Chr(209) & Chr(207)) Set fld = tdf.Fields("CurrencyNameDual") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(227) & Chr(203) & Chr(228) & Chr(236) & Chr(41)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(227) & Chr(203) & Chr(228) & Chr(236)) Set fld = tdf.Fields("CurrencyNamePlural") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(204) & Chr(227) & Chr(218) & Chr(41)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(204) & Chr(227) & Chr(218)) Set fld = tdf.Fields("CurrencyNameAccusative") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(205) & Chr(199) & Chr(225) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(228) & Chr(213) & Chr(200) & Chr(41)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(205) & Chr(199) & Chr(225) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(228) & Chr(213) & Chr(200)) Set fld = tdf.Fields("CurrencyBaseValue") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(195) & Chr(211) & Chr(199) & Chr(211) & Chr(237) & Chr(201)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(225) & Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(195) & Chr(211) & Chr(199) & Chr(211) & Chr(237) & Chr(201) & Chr(32) & Chr(225) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201)) Set fld = tdf.Fields("isCurrencyFeminine") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(229) & Chr(225) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(227) & Chr(196) & Chr(228) & Chr(203) & Chr(201)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(202) & Chr(221) & Chr(218) & Chr(237) & Chr(225) & Chr(32) & Chr(228) & Chr(230) & Chr(218) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(32) & Chr(227) & Chr(196) & Chr(228) & Chr(203) & Chr(201) & Chr(32) & Chr(41) & Chr(32) & Chr(225) & Chr(199) & Chr(211) & Chr(202) & Chr(206) & Chr(207) & Chr(199) & Chr(227) & Chr(229) & Chr(199) & Chr(32) & Chr(221) & Chr(237) & Chr(32) & Chr(199) & Chr(225) & Chr(202) & Chr(216) & Chr(200) & Chr(237) & Chr(222) & Chr(199) & Chr(202)) Set fld = tdf.Fields("NumberOfDecimalPlaces") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(218) & Chr(207) & Chr(207) & Chr(32) & Chr(199) & Chr(225) & Chr(206) & Chr(199) & Chr(228) & Chr(199) & Chr(202) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(212) & Chr(209) & Chr(237) & Chr(201)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(218) & Chr(207) & Chr(207) & Chr(32) & Chr(199) & Chr(225) & Chr(206) & Chr(199) & Chr(228) & Chr(199) & Chr(202) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(212) & Chr(209) & Chr(237) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(227) & Chr(211) & Chr(202) & Chr(206) & Chr(207) & Chr(227) & Chr(201) & Chr(32) & Chr(221) & Chr(237) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201)) Set fld = tdf.Fields("FractionalUnitSingular") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(227) & Chr(221) & Chr(209) & Chr(207) & Chr(41)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(227) & Chr(221) & Chr(209) & Chr(207)) Set fld = tdf.Fields("FractionalUnitDual") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(227) & Chr(203) & Chr(228) & Chr(236) & Chr(41)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(227) & Chr(203) & Chr(228) & Chr(236)) Set fld = tdf.Fields("FractionalUnitPlural") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(204) & Chr(227) & Chr(218) & Chr(41)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(204) & Chr(227) & Chr(218)) Set fld = tdf.Fields("FractionalUnitAccusative") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(205) & Chr(199) & Chr(225) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(228) & Chr(213) & Chr(200) & Chr(41)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(205) & Chr(199) & Chr(225) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(228) & Chr(213) & Chr(200)) Set fld = tdf.Fields("FractionalUnitBaseValue") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(195) & Chr(211) & Chr(199) & Chr(211) & Chr(237) & Chr(201)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(225) & Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(195) & Chr(211) & Chr(199) & Chr(211) & Chr(237) & Chr(201) & Chr(32) & Chr(225) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201)) Set fld = tdf.Fields("CurrencyNameSingularOtherLang") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(227) & Chr(221) & Chr(209) & Chr(207) & Chr(41) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(227) & Chr(221) & Chr(209) & Chr(207) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) Set fld = tdf.Fields("CurrencyNameDualOtherLang") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(227) & Chr(203) & Chr(228) & Chr(236) & Chr(41) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(227) & Chr(203) & Chr(228) & Chr(236) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) Set fld = tdf.Fields("CurrencyNamePluralOtherLang") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(204) & Chr(227) & Chr(218) & Chr(41) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(204) & Chr(227) & Chr(218) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) Set fld = tdf.Fields("CurrencyNameAccusativeOtherLang") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(205) & Chr(199) & Chr(225) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(228) & Chr(213) & Chr(200) & Chr(41) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(205) & Chr(199) & Chr(225) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(228) & Chr(213) & Chr(200) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) Set fld = tdf.Fields("CurrencyBaseValueOtherLang") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(225) & Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(195) & Chr(211) & Chr(199) & Chr(211) & Chr(237) & Chr(201) & Chr(32) & Chr(225) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) Set fld = tdf.Fields("FractionalUnitSingularOtherLang") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(227) & Chr(221) & Chr(209) & Chr(207) & Chr(41) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(227) & Chr(221) & Chr(209) & Chr(207) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) Set fld = tdf.Fields("FractionalUnitDualOtherLang") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(227) & Chr(203) & Chr(228) & Chr(236) & Chr(41) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(227) & Chr(203) & Chr(228) & Chr(236) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) Set fld = tdf.Fields("FractionalUnitPluralOtherLang") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(204) & Chr(227) & Chr(218) & Chr(41) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(204) & Chr(227) & Chr(218) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) Set fld = tdf.Fields("FractionalUnitAccusativeOtherLang") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(40) & Chr(205) & Chr(199) & Chr(225) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(228) & Chr(213) & Chr(200) & Chr(41) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(211) & Chr(227) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(213) & Chr(237) & Chr(219) & Chr(201) & Chr(32) & Chr(205) & Chr(199) & Chr(225) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(228) & Chr(213) & Chr(200) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) Set fld = tdf.Fields("FractionalUnitBaseValueOtherLang") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(199) & Chr(225) & Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(199) & Chr(225) & Chr(195) & Chr(211) & Chr(199) & Chr(211) & Chr(237) & Chr(201) & Chr(32) & Chr(225) & Chr(223) & Chr(211) & Chr(209) & Chr(32) & Chr(199) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201) & Chr(32) & Chr(200) & Chr(225) & Chr(219) & Chr(201) & Chr(32) & Chr(195) & Chr(206) & Chr(209) & Chr(236)) Set fld = tdf.Fields("CurrencyISOCode") fld.Properties.Append fld.CreateProperty("Caption", dbText, Chr(209) & Chr(227) & Chr(210) & Chr(32) & Chr(73) & Chr(83) & Chr(79) & Chr(32) & Chr(225) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201)) fld.Properties.Append fld.CreateProperty("Description", dbText, Chr(209) & Chr(227) & Chr(210) & Chr(32) & Chr(73) & Chr(83) & Chr(79) & Chr(32) & Chr(199) & Chr(225) & Chr(227) & Chr(206) & Chr(213) & Chr(213) & Chr(32) & Chr(225) & Chr(225) & Chr(218) & Chr(227) & Chr(225) & Chr(201)) ' Release objects Set tdf = Nothing Set db = Nothing ' Refresh the database window to show the new table Application.RefreshDatabaseWindow ' Optional: Notify the user that the table was created successfully ' MsgBox "The table was created and the label and description were set successfully. ", vbInformation Exit Sub ErrorHandler: If Err.number = 3010 Then ' Release objects Set tdf = Nothing Set db = Nothing Exit Sub Else ' Release objects Set tdf = Nothing Set db = Nothing End If ' Release objects Set tdf = Nothing Set db = Nothing End Sub '********************************************************************** ' Sub: CreateAndUpdateCurrencyTable ' Purpose: Ensures that the "tblCurrencyInfo" table is created and populated with default values. ' Inputs: None ' Returns: None ' Notes: This subroutine calls two other subroutines, CreateCurrencyTable and UpdateCurrencyTable, ' to first create the "tblCurrencyInfo" table and then populate it with default values. ' It is designed to streamline the process of setting up the currency table with ' the necessary data. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Sub CreateAndUpdateCurrencyTable() ' Ensure that the "tblCurrencyInfo" table is created CreateCurrencyTable ' Populate the "tblCurrencyInfo" table with default values UpdateCurrencyTable End Sub '********************************************************************** ' Function: GetCurrencyValues ' Purpose: Retrieves the values associated with a specific currency type, ' including its representations in both singular, dual, and plural forms ' for the specified language. ' Inputs: ' - Optional CurrencyType: The type of currency to retrieve values for. ' If not provided, defaults to an empty string which may result ' in fetching a default or active currency. ' - Optional language: The language for which the currency values should be retrieved. ' Defaults to "ar" (Arabic). ' Returns: Variant - An array containing the currency values in the specified language ' and formats (singular, dual, plural, etc.). ' Notes: ' - The function can be extended to handle different languages and currency formats. ' - If no CurrencyType is specified, it might fetch the values of a default or currently active currency. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Function GetCurrencyValues(Optional CurrencyType As String = "", Optional language As String = "ar") As Variant On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim query As String Dim currencyValues() As Variant ' Open a connection to the current database Set db = CurrentDb ' Determine the query based on CurrencyType If CurrencyType <> "" Then query = "SELECT * FROM tblCurrencyInfo WHERE CurrencyNameSingular = '" & CurrencyType & "'" Else query = "SELECT * FROM tblCurrencyInfo WHERE IsCurrencyActive = TRUE" End If ' Open the recordset with the query Set rs = db.OpenRecordset(query) ' Check if the recordset is empty If rs.EOF Then ' Provide default currency values if no records are found If language = "ar" Then ReDim currencyValues(12) ' Increased size to include CurrencyISOCode, NumberOfDecimalPlaces, and isCurrencyFeminine ' Set default values for Arabic language currencyValues(0) = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(32) & Chr(227) & Chr(213) & Chr(209) & Chr(237) currencyValues(1) = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(199) & Chr(228) currencyValues(2) = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(199) & Chr(202) currencyValues(3) = Chr(204) & Chr(228) & Chr(237) & Chr(229) currencyValues(4) = "0" currencyValues(5) = Chr(222) & Chr(209) & Chr(212) currencyValues(6) = Chr(222) & Chr(209) & Chr(212) & Chr(199) & Chr(228) currencyValues(7) = Chr(222) & Chr(209) & Chr(230) & Chr(212) currencyValues(8) = Chr(222) & Chr(209) & Chr(212) currencyValues(9) = "0" currencyValues(10) = "EGP" ' Default CurrencyISOCode currencyValues(11) = 2 ' Default NumberOfDecimalPlaces currencyValues(12) = False ' Default isCurrencyFeminine Else ReDim currencyValues(12) ' Increased size to include CurrencyISOCode, NumberOfDecimalPlaces, and isCurrencyFeminine ' Set default values for English language currencyValues(0) = "Egyptian Pound" currencyValues(1) = "Two Egyptian Pounds" currencyValues(2) = "Egyptian Pounds" currencyValues(3) = "One Egyptian Pound" currencyValues(4) = "0" currencyValues(5) = "Piastre" currencyValues(6) = "Two Piastres" currencyValues(7) = "Piastres" currencyValues(8) = "One Piastre" currencyValues(9) = "0" currencyValues(10) = "EGP" ' Default CurrencyISOCode currencyValues(11) = 2 ' Default NumberOfDecimalPlaces currencyValues(12) = False ' Default isCurrencyFeminine End If ' Clean up and exit rs.Close Set rs = Nothing Set db = Nothing GetCurrencyValues = currencyValues Exit Function End If ' Determine which fields to retrieve based on the language parameter If language = "EN" Then ' Retrieve values for English ReDim currencyValues(12) ' Increased size to include CurrencyISOCode, NumberOfDecimalPlaces, and isCurrencyFeminine currencyValues(0) = rs.Fields("CurrencyNameSingularOtherLang").Value currencyValues(1) = rs.Fields("CurrencyNameDualOtherLang").Value currencyValues(2) = rs.Fields("CurrencyNamePluralOtherLang").Value currencyValues(3) = rs.Fields("CurrencyNameAccusativeOtherLang").Value currencyValues(4) = rs.Fields("CurrencyBaseValueOtherLang").Value currencyValues(5) = rs.Fields("FractionalUnitSingularOtherLang").Value currencyValues(6) = rs.Fields("FractionalUnitDualOtherLang").Value currencyValues(7) = rs.Fields("FractionalUnitPluralOtherLang").Value currencyValues(8) = rs.Fields("FractionalUnitAccusativeOtherLang").Value currencyValues(9) = rs.Fields("FractionalUnitBaseValueOtherLang").Value currencyValues(10) = rs.Fields("CurrencyISOCode").Value currencyValues(11) = rs.Fields("NumberOfDecimalPlaces").Value currencyValues(12) = rs.Fields("isCurrencyFeminine").Value Else ' Retrieve values for Arabic ReDim currencyValues(12) ' Increased size to include CurrencyISOCode, NumberOfDecimalPlaces, and isCurrencyFeminine currencyValues(0) = rs.Fields("CurrencyNameSingular").Value currencyValues(1) = rs.Fields("CurrencyNameDual").Value currencyValues(2) = rs.Fields("CurrencyNamePlural").Value currencyValues(3) = rs.Fields("CurrencyNameAccusative").Value currencyValues(4) = rs.Fields("CurrencyValue").Value currencyValues(5) = rs.Fields("FractionalUnitSingular").Value currencyValues(6) = rs.Fields("FractionalUnitDual").Value currencyValues(7) = rs.Fields("FractionalUnitPlural").Value currencyValues(8) = rs.Fields("FractionalUnitAccusative").Value currencyValues(9) = rs.Fields("FractionalUnitBaseValue").Value currencyValues(10) = rs.Fields("CurrencyISOCode").Value currencyValues(11) = rs.Fields("NumberOfDecimalPlaces").Value currencyValues(12) = rs.Fields("isCurrencyFeminine").Value End If ' Close the recordset and database connection rs.Close Set rs = Nothing Set db = Nothing ' Return the array of currency values GetCurrencyValues = currencyValues Exit Function ErrorHandler: ' Handle errors: If the table is missing, call CreateAndUpdateCurrencyTable to create it If Err.number = 3078 Then Call CreateAndUpdateCurrencyTable Resume Else ' MsgBox "An error occurred: " & Err.Description, vbCritical Resume Next End If End Function '********************************************************************** ' Function: ConvertToWords ' Purpose: Converts a numeric value to its word representation, including currency terms if desired. ' Inputs: ' - num: The numeric value as a string to be converted to words. ' - currencyTerms: An array containing currency-related terms such as singular, dual, and plural forms. ' - Optional lang: The target language for the conversion. Defaults to "ar" (Arabic). ' - Optional ShowCurrency: A boolean indicating whether to include currency terms in the output. Defaults to True. ' Returns: String - The numeric value converted to words, optionally with currency terms. ' Notes: ' - Handles both integer and fractional parts of the number. ' - Supports multiple languages for the conversion process. ' - The `currencyTerms` parameter should be structured as an array with specific order (e.g., singular, dual, plural). ' - If `ShowCurrency` is False, only the numeric value in words will be returned without currency terms. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Function ConvertToWords(Num As String, currencyTerms As Variant, Optional lang As String = "ar", Optional ShowCurrency As Boolean = True) As String ', Optional CurrencyType As String = "" If Len(Num) >= 72 Then ' Handle the case when the string is too long On Error Resume Next ' Start error handling End If On Error GoTo 0 ' Reset error handling Dim units As Variant Dim unitsAlternate As Variant Dim tens As Variant Dim largeUnits As Variant Dim largeUnitsAlternate As Variant Dim unitsEn As Variant Dim tensEn As Variant Dim largeUnitsEn As Variant Dim i As Integer Dim segment As String Dim hundreds As Integer Dim tensValue As Integer Dim unitsValue As Integer Dim words As String Dim segmentSuffix As Integer ' Arabic values Dim arabicZero As String: arabicZero = Chr(213) & Chr(221) & Chr(209) Dim arabicOneFeminine As String: arabicOneFeminine = Chr(230) & Chr(199) & Chr(205) & Chr(207) & Chr(201) Dim arabicOne As String: arabicOne = Chr(230) & Chr(199) & Chr(205) & Chr(207) Dim arabicTwo As String: arabicTwo = Chr(199) & Chr(203) & Chr(228) & Chr(199) & Chr(228) Dim arabicThree As String: arabicThree = Chr(203) & Chr(225) & Chr(199) & Chr(203) & Chr(201) Dim arabicFour As String: arabicFour = Chr(195) & Chr(209) & Chr(200) & Chr(218) & Chr(201) Dim arabicFive As String: arabicFive = Chr(206) & Chr(227) & Chr(211) & Chr(201) Dim arabicSix As String: arabicSix = Chr(211) & Chr(202) & Chr(201) Dim arabicSeven As String: arabicSeven = Chr(211) & Chr(200) & Chr(218) & Chr(201) Dim arabicEight As String: arabicEight = Chr(203) & Chr(227) & Chr(199) & Chr(228) & Chr(237) & Chr(201) Dim arabicNine As String: arabicNine = Chr(202) & Chr(211) & Chr(218) & Chr(201) Dim arabicTen As String: arabicTen = Chr(218) & Chr(212) & Chr(209) & Chr(201) Dim arabicEleven As String: arabicEleven = Chr(195) & Chr(205) & Chr(207) & Chr(32) & Chr(218) & Chr(212) & Chr(209) Dim arabicTwelve As String: arabicTwelve = Chr(199) & Chr(203) & Chr(228) & Chr(199) & Chr(32) & Chr(218) & Chr(212) & Chr(209) Dim arabicThirteen As String: arabicThirteen = Chr(203) & Chr(225) & Chr(199) & Chr(203) & Chr(201) & Chr(32) & Chr(218) & Chr(212) & Chr(209) Dim arabicFourteen As String: arabicFourteen = Chr(195) & Chr(209) & Chr(200) & Chr(218) & Chr(201) & Chr(32) & Chr(218) & Chr(212) & Chr(209) Dim arabicFifteen As String: arabicFifteen = Chr(206) & Chr(227) & Chr(211) & Chr(201) & Chr(32) & Chr(218) & Chr(212) & Chr(209) Dim arabicSixteen As String: arabicSixteen = Chr(211) & Chr(202) & Chr(201) & Chr(32) & Chr(218) & Chr(212) & Chr(209) Dim arabicSeventeen As String: arabicSeventeen = Chr(211) & Chr(200) & Chr(218) & Chr(201) & Chr(32) & Chr(218) & Chr(212) & Chr(209) Dim arabicEighteen As String: arabicEighteen = Chr(203) & Chr(227) & Chr(199) & Chr(228) & Chr(237) & Chr(201) & Chr(32) & Chr(218) & Chr(212) & Chr(209) Dim arabicNineteen As String: arabicNineteen = Chr(202) & Chr(211) & Chr(218) & Chr(201) & Chr(32) & Chr(218) & Chr(212) & Chr(209) Dim arabicTwenty As String: arabicTwenty = Chr(218) & Chr(212) & Chr(209) & Chr(230) & Chr(228) Dim arabicThirty As String: arabicThirty = Chr(203) & Chr(225) & Chr(199) & Chr(203) & Chr(230) & Chr(228) Dim arabicForty As String: arabicForty = Chr(195) & Chr(209) & Chr(200) & Chr(218) & Chr(230) & Chr(228) Dim arabicFifty As String: arabicFifty = Chr(206) & Chr(227) & Chr(211) & Chr(230) & Chr(228) Dim arabicSixty As String: arabicSixty = Chr(211) & Chr(202) & Chr(230) & Chr(228) Dim arabicSeventy As String: arabicSeventy = Chr(211) & Chr(200) & Chr(218) & Chr(230) & Chr(228) Dim arabicEighty As String: arabicEighty = Chr(203) & Chr(227) & Chr(199) & Chr(228) & Chr(230) & Chr(228) Dim arabicNinety As String: arabicNinety = Chr(202) & Chr(211) & Chr(218) & Chr(230) & Chr(228) Dim arabicHundred As String: arabicHundred = Chr(227) & Chr(199) & Chr(198) & Chr(201) Dim arabicTwoHundred As String: arabicTwoHundred = Chr(227) & Chr(199) & Chr(198) & Chr(202) & Chr(199) & Chr(228) Dim arabicAlternateOne As String: arabicAlternateOne = Chr(197) & Chr(205) & Chr(207) & Chr(236) Dim arabicAlternateTwo As String: arabicAlternateTwo = Chr(199) & Chr(203) & Chr(228) & Chr(202) & Chr(199) & Chr(228) Dim arabicThousand As String: arabicThousand = Chr(195) & Chr(225) & Chr(221) Dim arabicThousandAlternate As String: arabicThousandAlternate = Chr(194) & Chr(225) & Chr(199) & Chr(221) Dim arabicMillion As String: arabicMillion = Chr(227) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicMillionAlternate As String: arabicMillionAlternate = Chr(227) & Chr(225) & Chr(199) & Chr(237) & Chr(237) & Chr(228) Dim arabicBillion As String: arabicBillion = Chr(200) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicBillionAlternate As String: arabicBillionAlternate = Chr(200) & Chr(225) & Chr(199) & Chr(237) & Chr(237) & Chr(228) Dim arabicTrillion As String: arabicTrillion = Chr(202) & Chr(209) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicTrillionAlternate As String: arabicTrillionAlternate = Chr(202) & Chr(209) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicQuadrillion As String: arabicQuadrillion = Chr(223) & Chr(230) & Chr(199) & Chr(207) & Chr(209) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicQuadrillionAlternate As String: arabicQuadrillionAlternate = Chr(223) & Chr(230) & Chr(199) & Chr(207) & Chr(209) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicQuintillion As String: arabicQuintillion = Chr(223) & Chr(230) & Chr(237) & Chr(228) & Chr(202) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicQuintillionAlternate As String: arabicQuintillionAlternate = Chr(223) & Chr(230) & Chr(237) & Chr(228) & Chr(202) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicSextillion As String: arabicSextillion = Chr(211) & Chr(223) & Chr(211) & Chr(202) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicSextillionAlternate As String: arabicSextillionAlternate = Chr(211) & Chr(223) & Chr(211) & Chr(202) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicSeptillion As String: arabicSeptillion = Chr(211) & Chr(237) & Chr(200) & Chr(202) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicSeptillionAlternate As String: arabicSeptillionAlternate = Chr(211) & Chr(237) & Chr(200) & Chr(202) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicOctillion As String: arabicOctillion = Chr(195) & Chr(230) & Chr(223) & Chr(202) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicOctillionAlternate As String: arabicOctillionAlternate = Chr(195) & Chr(230) & Chr(223) & Chr(202) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicNonillion As String: arabicNonillion = Chr(228) & Chr(230) & Chr(228) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicNonillionAlternate As String: arabicNonillionAlternate = Chr(228) & Chr(230) & Chr(228) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicDecillion As String: arabicDecillion = Chr(207) & Chr(237) & Chr(212) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicDecillionAlternate As String: arabicDecillionAlternate = Chr(207) & Chr(237) & Chr(212) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicUndecillion As String: arabicUndecillion = Chr(195) & Chr(230) & Chr(228) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicUndecillionAlternate As String: arabicUndecillionAlternate = Chr(195) & Chr(230) & Chr(228) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicDuodecillion As String: arabicDuodecillion = Chr(207) & Chr(230) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicDuodecillionAlternate As String: arabicDuodecillionAlternate = Chr(207) & Chr(230) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicTredecillion As String: arabicTredecillion = Chr(202) & Chr(209) & Chr(237) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicTredecillionAlternate As String: arabicTredecillionAlternate = Chr(202) & Chr(209) & Chr(237) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicQuattuordecillion As String: arabicQuattuordecillion = Chr(223) & Chr(230) & Chr(199) & Chr(202) & Chr(230) & Chr(209) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicQuattuordecillionAlternate As String: arabicQuattuordecillionAlternate = Chr(223) & Chr(230) & Chr(199) & Chr(202) & Chr(230) & Chr(209) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicQuindecillion As String: arabicQuindecillion = Chr(223) & Chr(230) & Chr(237) & Chr(228) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicQuindecillionAlternate As String: arabicQuindecillionAlternate = Chr(223) & Chr(230) & Chr(237) & Chr(228) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicSexdecillion As String: arabicSexdecillion = Chr(211) & Chr(223) & Chr(211) & Chr(202) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicSexdecillionAlternate As String: arabicSexdecillionAlternate = Chr(211) & Chr(223) & Chr(211) & Chr(202) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicSeptendecillion As String: arabicSeptendecillion = Chr(211) & Chr(237) & Chr(200) & Chr(202) & Chr(228) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicSeptendecillionAlternate As String: arabicSeptendecillionAlternate = Chr(211) & Chr(237) & Chr(200) & Chr(202) & Chr(228) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicOctodecillion As String: arabicOctodecillion = Chr(195) & Chr(230) & Chr(223) & Chr(202) & Chr(230) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicOctodecillionAlternate As String: arabicOctodecillionAlternate = Chr(195) & Chr(230) & Chr(223) & Chr(202) & Chr(230) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicNovemdecillion As String: arabicNovemdecillion = Chr(228) & Chr(230) & Chr(221) & Chr(237) & Chr(227) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicNovemdecillionAlternate As String: arabicNovemdecillionAlternate = Chr(228) & Chr(230) & Chr(221) & Chr(237) & Chr(227) & Chr(207) & Chr(237) & Chr(211) & Chr(237) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicVigintillion As String: arabicVigintillion = Chr(221) & Chr(237) & Chr(204) & Chr(237) & Chr(228) & Chr(202) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicVigintillionAlternate As String: arabicVigintillionAlternate = Chr(221) & Chr(237) & Chr(204) & Chr(237) & Chr(228) & Chr(202) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicCentillion As String: arabicCentillion = Chr(211) & Chr(228) & Chr(202) & Chr(225) & Chr(237) & Chr(230) & Chr(228) Dim arabicCentillionAlternate As String: arabicCentillionAlternate = Chr(211) & Chr(228) & Chr(202) & Chr(225) & Chr(237) & Chr(230) & Chr(228) & Chr(199) & Chr(202) Dim arabicGoogol As String: arabicGoogol = Chr(204) & Chr(230) & Chr(204) & Chr(230) & Chr(225) units = Array(arabicZero, arabicOne, arabicTwo, arabicThree, arabicFour, arabicFive, arabicSix, arabicSeven, arabicEight, arabicNine, arabicTen, arabicEleven, arabicTwelve, _ arabicThirteen, arabicFourteen, arabicFifteen, arabicSixteen, arabicSeventeen, arabicEighteen, arabicNineteen) unitsAlternate = Array(arabicZero, arabicAlternateOne, arabicAlternateTwo, Chr(203) & Chr(225) & Chr(199) & Chr(203), Chr(195) & Chr(209) & Chr(200) & Chr(218), _ Chr(206) & Chr(227) & Chr(211), Chr(211) & Chr(202), Chr(211) & Chr(200) & Chr(218), Chr(203) & Chr(227) & Chr(199) & Chr(228), Chr(202) & Chr(211) & Chr(218), _ Chr(218) & Chr(212) & Chr(209), Chr(197) & Chr(205) & Chr(207) & Chr(236) & Chr(32) & Chr(218) & Chr(212) & Chr(209) & Chr(201), Chr(199) & Chr(203) & Chr(228) & Chr(202) & Chr(199) & Chr(32) & Chr(218) & Chr(212) & Chr(209) & Chr(201), _ Chr(203) & Chr(225) & Chr(199) & Chr(203) & Chr(32) & Chr(218) & Chr(212) & Chr(209) & Chr(201), Chr(195) & Chr(209) & Chr(200) & Chr(218) & Chr(32) & Chr(218) & Chr(212) & Chr(209) & Chr(201), _ Chr(206) & Chr(227) & Chr(211) & Chr(32) & Chr(218) & Chr(212) & Chr(209) & Chr(201), Chr(211) & Chr(202) & Chr(32) & Chr(218) & Chr(212) & Chr(209) & Chr(201), _ Chr(211) & Chr(200) & Chr(218) & Chr(32) & Chr(218) & Chr(212) & Chr(209) & Chr(201), Chr(203) & Chr(227) & Chr(199) & Chr(228) & Chr(237) & Chr(32) & Chr(218) & Chr(212) & Chr(209) & Chr(201), _ Chr(202) & Chr(211) & Chr(218) & Chr(32) & Chr(218) & Chr(212) & Chr(209) & Chr(201)) tens = Array("", "", arabicTwenty, arabicThirty, arabicForty, arabicFifty, arabicSixty, arabicSeventy, arabicEighty, arabicNinety) largeUnits = Array("", arabicThousand, arabicMillion, arabicBillion, arabicTrillion, arabicQuadrillion, arabicQuintillion, arabicSextillion, arabicSeptillion, arabicOctillion, arabicNonillion, arabicDecillion, arabicUndecillion, arabicDuodecillion, arabicTredecillion, arabicQuattuordecillion, arabicQuindecillion, arabicSexdecillion, arabicSeptendecillion, arabicOctodecillion, arabicNovemdecillion, arabicVigintillion, arabicCentillion, arabicGoogol) largeUnitsAlternate = Array("", arabicThousandAlternate, arabicMillionAlternate, arabicBillionAlternate, arabicTrillionAlternate, arabicQuadrillionAlternate, arabicQuintillionAlternate, arabicSextillionAlternate, arabicSeptillionAlternate, arabicOctillionAlternate, arabicNonillionAlternate, arabicDecillionAlternate, arabicUndecillionAlternate, arabicDuodecillionAlternate, arabicTredecillionAlternate, arabicQuattuordecillionAlternate, arabicQuindecillionAlternate, arabicSexdecillionAlternate, arabicSeptendecillionAlternate, arabicOctodecillionAlternate, arabicNovemdecillionAlternate, arabicVigintillionAlternate, arabicCentillionAlternate, arabicGoogol) ' English values unitsEn = Array("zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen") tensEn = Array("", "", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety") ' English values unitsEn = Array("zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen") tensEn = Array("", "", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety") largeUnitsEn = Array("", "thousand", "million", "billion", "trillion", "quadrillion", "quintillion", "sextillion", "septillion", "octillion", "nonillion", "decillion", "undecillion", "duodecillion", "tredecillion", "quattuordecillion", "quindecillion", "sexdecillion", "septendecillion", "octodecillion", "novemdecillion", "vigintillion", "centillion", "googol") ' Initialize words to empty words = "" ' Process each segment of the number (three digits at a time) ' If the number is too large, convert it to scientific notation If Len(Num) >= 21 Then Num = Format(Num, "0E+0") Else Num = Format(Num, "0") End If ' Split the number into segments of three digits For i = 0 To Int((Len(Num) - 1) / 3) segment = Right(Mid(Num, 1, Len(Num) - i * 3), 3) ' Convert the segment to an integer If IsNumeric(segment) Then segment = CInt(segment) ' Process hundreds and tens hundreds = Int(segment / 100) tensValue = segment Mod 100 ' Perform the necessary operations with hundreds and tensValue ' (Add your specific logic here) Else ' Handle cases where segment is not numeric (in case of scientific notation) ' You might want to skip or handle these differently End If segmentSuffix = IIf(i = 0, currencyTerms(4), 0) ' Process tens and units If tensValue > 0 Then If tensValue < 20 Then ' Handle numbers from 1 to 19 If lang = "ar" Then On Error Resume Next words = IIf(tensValue > 2, IIf(segmentSuffix = 0, units(tensValue), unitsAlternate(tensValue)) & " " & IIf(tensValue > 10 And Len(largeUnits(i)) > 0, largeUnits(i) & IIf(words <> "", Chr(32) & Chr(230) & Chr(32), ""), largeUnitsAlternate(i)), IIf(Len(largeUnits(i)) > 0, largeUnits(i) & IIf(tensValue = 1, "", IIf(tensValue = 2 And words <> "" Or ShowCurrency = False, Chr(199) & Chr(228), Chr(199))), IIf(tensValue Mod 10 <> 0, "", IIf(segmentSuffix = 0, units(tensValue), unitsAlternate(tensValue))))) & IIf(words = "", IIf(Len(largeUnits(i)) > 0, " " & IIf(ShowCurrency, currencyTerms(0), ""), IIf(tensValue = 1, IIf(ShowCurrency, currencyTerms(0), arabicOne), IIf(tensValue = 2, IIf(ShowCurrency, currencyTerms(1), arabicTwo), IIf(tensValue < 11, IIf(ShowCurrency, currencyTerms(2), ""), IIf(ShowCurrency, currencyTerms(3), ""))))), Chr(32) & Chr(230) & Chr(32) & words) Else On Error Resume Next words = unitsEn(tensValue) & " " & largeUnitsEn(i) & IIf(words = "", IIf(Len(largeUnits(i)) > 0, " ", "") & IIf(Num > 1, IIf(ShowCurrency, currencyTerms(2), ""), IIf(ShowCurrency, currencyTerms(0), "")), " " & words) End If On Error GoTo 0 ' Reset the error handling Else ' Handle numbers from 20 and above If lang = "ar" Then words = IIf(tensValue Mod 10 = 0, "", IIf(segmentSuffix = 0, units(tensValue Mod 10), IIf(tensValue Mod 10 = 8, Left(unitsAlternate(8), 4), unitsAlternate(tensValue Mod 10))) & Chr(32) & Chr(230) & Chr(32)) & tens(Int(tensValue / 10)) & " " & largeUnits(i) & IIf(words <> "" And Len(largeUnits(i)) > 0, Chr(32) & Chr(230) & Chr(32), "") & IIf(words = "", IIf(Len(largeUnits(i)) > 0, " " & IIf(ShowCurrency, currencyTerms(0), ""), IIf(ShowCurrency, currencyTerms(3), "")), Chr(32) & Chr(230) & Chr(32) & words) Else words = tensEn(Int(tensValue / 10)) & IIf(tensValue Mod 10 = 0, "", "-") & unitsEn(tensValue Mod 10) & " " & largeUnitsEn(i) & IIf(words = "", IIf(Len(largeUnits(i)) > 0, " ", "") & IIf(Num > 1, IIf(ShowCurrency, currencyTerms(2), ""), IIf(ShowCurrency, currencyTerms(0), "")), " " & words) End If End If End If ' Process hundreds If hundreds > 0 Then If lang = "ar" Then On Error Resume Next words = IIf(hundreds = 1, Chr(227) & Chr(199) & Chr(198) & Chr(201), IIf(hundreds = 2, Chr(227) & Chr(199) & Chr(198) & Chr(202) & Chr(199) & IIf(tensValue > 0 Or ShowCurrency = False, Chr(228), ""), Mid(units(hundreds), 1, Len(units(hundreds)) - IIf(hundreds = 8, 2, 1)) & Chr(227) & Chr(199) & Chr(198) & Chr(201))) & IIf(tensValue = 0, IIf(Len(largeUnits(i)) > 0, " ", "") & largeUnits(i), "") & IIf(words = "", " " & IIf(ShowCurrency, currencyTerms(0), ""), Chr(32) & Chr(230) & Chr(32) & words) Else On Error Resume Next words = unitsEn(hundreds) & " hundred" & IIf(tensValue > 0, "", " " & largeUnitsEn(i)) & IIf(words = "", IIf(Len(largeUnits(i)) > 0, " ", "") & IIf(Num > 1, IIf(ShowCurrency, currencyTerms(2), ""), IIf(ShowCurrency, currencyTerms(0), "")), " " & words) On Error GoTo 0 ' Reset the error handling End If End If Next i ' Process Zeros If (segment = "" Or segment = "0") And tensValue = 0 And ShowCurrency = False Then If lang = "ar" Then words = arabicZero Else words = unitsEn(0) End If End If ' Check if the number is 1 (for singular currency terms) If val(Num) = 1 Then If lang = "ar" Then If segmentSuffix Then words = IIf(ShowCurrency, currencyTerms(0), "") & " " & arabicOneFeminine Else words = IIf(ShowCurrency, currencyTerms(0), "") & " " & arabicOne End If Else words = unitsEn(1) & " " & IIf(ShowCurrency, currencyTerms(0), "") End If End If ' Return the result ConvertToWords = words End Function '********************************************************************** ' Function: ConvertCurrencyToWords ' Purpose: Converts a numeric value to its word representation in a specified language, ' with optional currency terms and additional formatting options. ' Inputs: ' - Number: The numeric value to be converted. Can be an integer or a floating-point number. ' - Optional CurrencyType: Specifies the currency type for which the number should be converted ' into words (e.g., Dollars, Euros). If not provided, it defaults to an empty string. ' - Optional language: The target language for the word representation. ' Defaults to "ar" (Arabic), but can be set to other languages such as "en" (English). ' - Optional ShowExtras: A boolean flag that determines whether additional information like ' currency units (e.g., cents, piastres) or other formatting should be included. ' Defaults to True. ' Returns: String - The numeric value expressed in words, formatted according to the specified language ' and currency type. ' Notes: ' - Handles both integer and fractional parts of the number. ' - The function can be extended to support additional languages and currencies. ' - The ShowExtras parameter allows for customized output, enabling or disabling extra formatting based on user preference. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Function ConvertCurrencyToWords(number As Variant, Optional CurrencyType As String = "", Optional language As String = "ar", Optional ShowExtras As Boolean = True) As String ' Check if the input is not a numeric value If Not IsNumeric(number) Then ' If the language is Arabic, return an "Invalid value" message in Arabic If language = "ar" Then ConvertCurrencyToWords = "" ' If the language is English, return an "Invalid value" message in English ElseIf language = "En" Then ConvertCurrencyToWords = "" ' Otherwise, return the original number (using Nz to handle Null values) End If ' Exit the function if the value is not numeric Exit Function ' Check if the number is empty or has zero length ElseIf Nz(number, "") = "" Or Len(Nz(number, "")) = "" Then ConvertCurrencyToWords = "" ' Return an empty string Exit Function ' Check if the number is zero ElseIf CDbl(number) = 0 Then ' If the language is Arabic, return "Zero" in Arabic If language = "ar" Then ConvertCurrencyToWords = Chr(213) & Chr(221) & Chr(209) ' If the language is English, return "Zero" ElseIf language = "En" Then ConvertCurrencyToWords = "Zero" ' Otherwise, return the number itself ElseIf Len(number) >= 72 Then Resume Next Else ConvertCurrencyToWords = number End If ' Exit the function if the value is zero Exit Function End If ' Determine if the number is negative Dim isNegative As Boolean isNegative = (number < 0) ' If the number is negative, convert it to a positive value If isNegative Then number = Abs(number) End If ' If the number has 21 or more digits, convert it to scientific notation If Len(number) >= 21 Then number = Format(number, "0E+0") ' Define CurrencyUnits and CurrencySubUnits based on CurrencyType Dim CurrencyUnits As Variant Dim CurrencySubUnits As Variant Dim PrefixText As String Dim SuffixText As String Dim currencyValues As Variant Dim NumberOfDecimalPlaces As Integer Dim isCurrencyFeminine As Boolean ' Get currency values based on the language and CurrencyType currencyValues = GetCurrencyValues(CurrencyType, language) NumberOfDecimalPlaces = IIf(ShowExtras, IIf(IsNumeric(currencyValues(11)), currencyValues(11), 2), 3) isCurrencyFeminine = IIf(ShowExtras, currencyValues(12), False) If language = "ar" Then CurrencyUnits = Array(currencyValues(0), currencyValues(1), currencyValues(2), currencyValues(3), currencyValues(4)) CurrencySubUnits = Array(currencyValues(5), currencyValues(6), currencyValues(7), currencyValues(8), isCurrencyFeminine) PrefixText = IIf(ShowExtras, Chr(32) & Chr(221) & Chr(222) & Chr(216) & Chr(32), "") SuffixText = IIf(ShowExtras, Chr(225) & Chr(199) & Chr(32) & Chr(219) & Chr(237) & Chr(209), "") Else CurrencyUnits = Array(currencyValues(0), currencyValues(1), currencyValues(2), currencyValues(3), currencyValues(4)) CurrencySubUnits = Array(currencyValues(5), currencyValues(6), currencyValues(7), currencyValues(8), currencyValues(9), isCurrencyFeminine) PrefixText = IIf(ShowExtras, "Just", "") SuffixText = IIf(ShowExtras, "nothing more", "") End If Dim fullNumber As Variant Dim integerPart As String Dim fractionalPart As String Dim integerWords As String Dim fractionalWords As String If IsNumeric(number) And number > 0 Then fullNumber = Split(IIf(InStr(number, ".") > 0, number, number & ".0"), ".") integerPart = IIf(Len(fullNumber(0)) > 21, Right(fullNumber(0), 21), fullNumber(0)) fractionalPart = Mid(fullNumber(1) & String(20, "0"), 1, NumberOfDecimalPlaces) integerWords = ConvertToWords(integerPart, CurrencyUnits, language, ShowExtras) If ShowExtras = True Then On Error Resume Next fractionalWords = IIf(fractionalPart > 0, ConvertToWords(fractionalPart, CurrencySubUnits, language, ShowExtras), "") On Error GoTo 0 ' Reset the error handling Else fractionalPart = fullNumber(1) fractionalWords = IIf(fractionalPart > 0, ConvertToWords(fractionalPart, CurrencySubUnits, language, ShowExtras), "") End If fractionalWords = IIf(Len(fractionalWords) > 0, IIf(ShowExtras, "", IIf(language = "Ar", Chr(32) & Chr(221) & Chr(199) & Chr(213) & Chr(225) & Chr(32), " point ")) & fractionalWords, fractionalWords) Dim ResultConvert As String ResultConvert = PrefixText & " " & IIf(isNegative, IIf(language = "Ar", Chr(211) & Chr(199) & Chr(225) & Chr(200), "Negative") & " ", "") & integerWords & IIf(Len(integerWords) > 0 And Len(fractionalWords) > 0, IIf(language = "ar", IIf(ShowExtras, Chr(32) & Chr(230) & Chr(32), ""), IIf(ShowExtras, " and ", "")), "") & fractionalWords & " " & SuffixText ResultConvert = Trim(Replace(ResultConvert, " ", " ")) If ResultConvert = Chr(221) & Chr(222) & Chr(216) & " " & Chr(225) & Chr(199) & Chr(32) & Chr(219) & Chr(237) & Chr(209) Then ResultConvert = "" If ResultConvert = "Only" & Space(1) & "No more" Then ResultConvert = "" ConvertCurrencyToWords = ResultConvert Else ConvertCurrencyToWords = Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(219) & Chr(237) & Chr(209) & Chr(32) & Chr(213) & Chr(199) & Chr(225) & Chr(205) & Chr(201) End If End Function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Start code Convert NumberTo Words with out Currency Data "" Just Only Number ' ' ' ' ' ' '********************************************************************** ' Function: GenerateLeadingZerosText ' Purpose: Generates a textual representation of leading zeros in a number. ' Inputs: s - A string representing the numeric value to analyze. ' lang - An optional string specifying the language ("ar" for Arabic, "en" for English). ' Returns: String - A textual representation of the leading zeros. ' Notes: This function returns a string of "zero and" or "صفر و" for each leading zero ' depending on the specified language. If an unsupported language is provided, ' it returns "Unsupported language". '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Function GenerateLeadingZerosText(s As String, Optional lang As String = "ar") As String Dim zeroCount As Integer Dim resultText As String Dim zeroWord As String ' Determine the word for zero based on the specified language If lang = "ar" Then zeroWord = Chr(213) & Chr(221) & Chr(209) & Chr(32) & Chr(230) ElseIf lang = "en" Then zeroWord = "zero and " Else GenerateLeadingZerosText = "Unsupported language" Exit Function End If zeroCount = 0 ' Count leading zeros and build the result string Do While Mid(s, zeroCount + 1, 1) = "0" And zeroCount < Len(s) resultText = resultText & zeroWord & " " zeroCount = zeroCount + 1 Loop ' Remove the trailing space if there were leading zeros If Len(resultText) > 0 Then resultText = Left(resultText, Len(resultText) - 1) End If GenerateLeadingZerosText = resultText End Function '********************************************************************** ' Function: ExtractNumberParts ' Purpose: Extracts the integer and decimal parts of a number string. ' Inputs: number - A string representing the numeric value to be extracted. ' integerPart - A ByRef string to hold the integer part of the number. ' decimalPart - A ByRef string to hold the decimal part of the number. ' DecimalRound - An optional integer specifying the number of decimal places to round. ' Returns: String - A formatted string indicating the extracted parts. ' Notes: This function handles the extraction of integer and decimal parts ' from a numeric string and provides a formatted result. If there are ' decimals, they are processed accordingly. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Function ExtractNumberParts(number As String, ByRef integerPart As String, ByRef decimalPart As String, Optional DecimalRound As Integer = 10) As String Dim numString As String Dim decimalPosition As Integer Dim decimalLength As Integer numString = CStr(number) decimalPosition = InStr(numString, ".") If decimalPosition > 0 Then integerPart = Left(numString, decimalPosition - 1) decimalPart = Mid(numString, decimalPosition + 1) decimalLength = Len(decimalPart) Else integerPart = numString decimalPart = "" End If Dim result As String result = "Integer Part: " & integerPart & ", Decimal Part: " & decimalPart ' Debug.Print "Integer Part :" & integerPart ' Debug.Print "Decimal Part :" & decimalPart ExtractNumberParts = result End Function '********************************************************************** ' Function: ConvertNumberToWords ' Purpose: Converts a numeric string into its textual representation, including ' both integer and decimal parts, in the specified language. ' Inputs: num - A string representing the numeric value to be converted. ' lang - An optional string specifying the language ("ar" for Arabic, "en" for English). ' Returns: String - The textual representation of the numeric value, including ' integer, leading zeros, and decimal parts. ' Notes: This function combines the integer and decimal parts into a final ' textual representation, using appropriate conjunctions based on ' the specified language. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Function ConvertNumberToWords(Num As String, Optional lang As String = "ar") As String Dim integerPart As String Dim decimalPart As String Dim integerWords As String Dim decimalWords As String Dim leadingZerosWords As String Dim conjunction As String Dim strNegative As String Dim isNegative As Boolean ' Extract integer and decimal parts of the number Call ExtractNumberParts(Num, integerPart, decimalPart) ' Convert integer and decimal parts to words integerWords = ConvertCurrencyToWords(integerPart, "", lang, False) decimalWords = ConvertCurrencyToWords(decimalPart, "", lang, False) If InStr(integerPart, "-") > 0 Then isNegative = True strNegative = IIf(lang = "ar", Chr(32) & Chr(211) & Chr(199) & Chr(225) & Chr(200), " Negative ") Else isNegative = False strNegative = IIf(lang = "ar", "", "") End If ' Generate leading zeros text if applicable leadingZerosWords = GenerateLeadingZerosText(decimalPart, lang) ' Define the prefix and suffix based on the language Dim prefix As String: prefix = IIf(lang = "ar", Chr(221) & Chr(222) & Chr(216), "Just ") Dim suffix As String: suffix = IIf(lang = "ar", Chr(32) & Chr(225) & Chr(199) & Chr(32) & Chr(219) & Chr(237) & Chr(209), " nothing more") Dim result As String ' Determine the conjunction based on the specified language If decimalWords = "" Then result = " " & prefix & " " & strNegative & " " & integerWords & " " & suffix & " " Else If lang = "ar" Then conjunction = Chr(32) & Chr(221) & Chr(199) & Chr(213) & Chr(225) & Chr(32) ElseIf lang = "en" Then conjunction = " Point " End If result = " " & prefix & " " & strNegative & " " & integerWords & " " & conjunction & " " & leadingZerosWords & " " & decimalWords & " " & suffix & " " End If ' Return an empty string if both integerWords and decimalWords are empty If integerWords = "" And decimalWords = "" Then result = "": Exit Function result = Replace(result, "and Zero nothing more", " nothing more") result = Replace(result, "Just Invalid value nothing more", "") result = Replace(result, "Point Invalid value", "") result = Replace(result, Chr(32) & Chr(230) & Chr(213) & Chr(221) & Chr(209) & Chr(32) & Chr(225) & Chr(199) & Chr(32) & Chr(219) & Chr(237) & Chr(209), _ Chr(32) & Chr(225) & Chr(199) & Chr(32) & Chr(219) & Chr(237) & Chr(209)) result = Replace(result, Chr(32) & Chr(230) & Chr(32) & Chr(230) & Chr(32), Chr(32) & Chr(230) & Chr(32)) result = Replace(result, " ", " ") ConvertNumberToWords = result End Function ' End >>---> code Convert NumberTo Words with out Currency Data "" Just Only Number ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '********************************************************************** ' Subroutine: LoadCurrencyNames ' Purpose: Loads currency names from the tblCurrencyInfo table into a collection. ' Inputs: None. ' Outputs: None. ' Returns: None. ' Notes: - The subroutine connects to the current database and retrieves ' the singular currency names from the tblCurrencyInfo table. ' - Currency names are stored in a Collection object to ensure ' unique entries (duplicates are ignored). ' - The subroutine demonstrates how to iterate over the collection ' and print the currency names to the debug console. ' - Error handling is used to manage duplicate entries gracefully. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Sub LoadCurrencyNames() Dim db As DAO.Database Dim rs As DAO.Recordset Dim currencyNames As Collection Dim currencyName As String Dim i As Integer ' Initialize the database object Set db = CurrentDb Set currencyNames = New Collection ' Open the recordset for the table tblCurrencyInfo Set rs = db.OpenRecordset("SELECT CurrencyNameSingular FROM tblCurrencyInfo", dbOpenSnapshot) ' Check if the recordset is not empty If Not rs.EOF Then ' Loop through each record and add the currency names to the collection Do While Not rs.EOF currencyName = rs!CurrencyNameSingular On Error Resume Next ' To handle duplicate entries currencyNames.Add currencyName, CStr(currencyName) On Error GoTo 0 ' Reset error handling rs.MoveNext Loop End If ' Close the recordset rs.Close Set rs = Nothing Set db = Nothing ' Example of how to use the collection For i = 1 To currencyNames.Count Debug.Print currencyNames(i) Next i End Sub '********************************************************************** ' Subroutine: PopulateComboBox ' Purpose: Populates a ComboBox with a list of currency names from the database. ' Inputs: cmbBox - The ComboBox control to be populated. ' Outputs: None. ' Returns: None. ' Notes: - This subroutine retrieves currency names from the "tblCurrencyInfo" ' table and adds them to the provided ComboBox. ' - It uses a Collection to temporarily store the currency names, ' ensuring no duplicates are added. ' - The ComboBox is cleared of existing items before new items are added. ' - Handles potential errors when adding duplicate entries to the Collection. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Sub PopulateComboBox(cmbBox As ComboBox) Dim db As DAO.Database Dim rs As DAO.Recordset Dim currencyNames As Collection Dim currencyName As String Dim i As Integer ' Initialize the database object Set db = CurrentDb Set currencyNames = New Collection ' Open the recordset for the table tblCurrencyInfo Set rs = db.OpenRecordset("SELECT CurrencyNameSingular FROM tblCurrencyInfo", dbOpenSnapshot) ' Check if the recordset is not empty If Not rs.EOF Then ' Loop through each record and add the currency names to the collection Do While Not rs.EOF currencyName = rs!CurrencyNameSingular On Error Resume Next ' To handle duplicate entries currencyNames.Add currencyName, CStr(currencyName) On Error GoTo 0 ' Reset error handling rs.MoveNext Loop End If ' Close the recordset rs.Close Set rs = Nothing Set db = Nothing ' Clear existing items in the ComboBox cmbBox.RowSource = "" ' Add items to the ComboBox from the collection For i = 1 To currencyNames.Count cmbBox.AddItem currencyNames(i) Next i End Sub '********************************************************************** ' Subroutine: CleanUpVariables ' Purpose: Resets all currency-related variables to their default values. ' Inputs: None. ' Outputs: None. ' Returns: None. ' Notes: - This subroutine is used to clean up or reset variables that store ' currency information in both Arabic and other languages. ' - It sets string variables to `vbNullString` (an empty string) ' and numerical variables to their default values. ' - It is useful to call this subroutine before loading new currency ' data or when you need to ensure that old data is cleared out. ' - The `NumberOfDecimalPlaces` is reset to `2`, and `isCurrencyFeminine` ' is set to `False` by default. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Sub CleanUpVariables() ' Clean up ' Currency Information By Arabic CurrencyNameSingular = vbNullString CurrencyNameDual = vbNullString CurrencyNamePlural = vbNullString CurrencyNameAccusative = vbNullString FractionalUnitSingular = vbNullString FractionalUnitDual = vbNullString FractionalUnitPlural = vbNullString FractionalUnitAccusative = vbNullString ' Currency Information By Other Language CurrencyNameSingularOtherLang = vbNullString CurrencyNameDualOtherLang = vbNullString CurrencyNamePluralOtherLang = vbNullString CurrencyNameAccusativeOtherLang = vbNullString FractionalUnitSingularOtherLang = vbNullString FractionalUnitDualOtherLang = vbNullString FractionalUnitPluralOtherLang = vbNullString FractionalUnitAccusativeOtherLang = vbNullString CurrencyISOCode = vbNullString NumberOfDecimalPlaces = 2 isCurrencyFeminine = False CurrencyBaseValue = 0 FractionalUnitBaseValue = 0 End Sub ' Constants of names of common currency fractions with more than one currency '********************************************************************** ' Function: Piastre ' Purpose: Returns the correct string representation of a fractional currency unit (Piastre) ' based on the input integer value. ' Inputs: num - Integer value representing the type of fractional unit. ' Outputs: None. ' Returns: String - The corresponding string representation of the fractional unit in Arabic or English. ' Notes: - The function uses Select Case to determine the appropriate string based on the input number. ' - The first four cases correspond to Arabic representations using character codes. ' - The last four cases correspond to English representations of the Piastre unit. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Public Function Piastre(Num As Integer) Dim FractionalUnit As String: FractionalUnit = "Piastre" Select Case Num ' Currency Information By Arabic Case Is = 1: FractionalUnit = Chr(222) & Chr(209) & Chr(212) Case Is = 2: FractionalUnit = Chr(222) & Chr(209) & Chr(212) & Chr(199) & Chr(228) Case Is = 3: FractionalUnit = Chr(222) & Chr(209) & Chr(230) & Chr(212) Case Is = 4: FractionalUnit = Chr(222) & Chr(209) & Chr(212) & Chr(199) & Chr(240) ' Currency Information By Other Language Case Is = 5: FractionalUnit = "Piastre" Case Is = 6: FractionalUnit = "Two Piastres" Case Is = 7: FractionalUnit = "Piastres" Case Is = 8: FractionalUnit = "One Piastre" End Select Piastre = FractionalUnit End Function Public Function Dirham(Num As Integer) Dim FractionalUnit As String: FractionalUnit = "Dirham" Select Case Num ' Currency Information By Arabic Case Is = 1: FractionalUnit = Chr(207) & Chr(209) & Chr(229) & Chr(227) Case Is = 2: FractionalUnit = Chr(207) & Chr(209) & Chr(229) & Chr(227) Case Is = 3: FractionalUnit = Chr(207) & Chr(209) & Chr(199) & Chr(229) & Chr(227) Case Is = 4: FractionalUnit = Chr(207) & Chr(209) & Chr(229) & Chr(227) & Chr(240) & Chr(199) ' Currency Information By Other Language Case Is = 5: FractionalUnit = "Dirham" Case Is = 6: FractionalUnit = "Two Dirhams" Case Is = 7: FractionalUnit = "Dirhams" Case Is = 8: FractionalUnit = "One Dirham" End Select Dirham = FractionalUnit End Function Public Function Fils(Num As Integer) Dim FractionalUnit As String: FractionalUnit = "Fils" Select Case Num ' Currency Information By Arabic Case Is = 1: FractionalUnit = Chr(221) & Chr(225) & Chr(211) Case Is = 2: FractionalUnit = Chr(221) & Chr(225) & Chr(211) & Chr(199) & Chr(228) Case Is = 3: FractionalUnit = Chr(221) & Chr(225) & Chr(230) & Chr(211) Case Is = 4: FractionalUnit = Chr(221) & Chr(225) & Chr(211) & Chr(240) & Chr(199) ' Currency Information By Other Language Case Is = 5: FractionalUnit = "Fils" Case Is = 6: FractionalUnit = "Two Fils" Case Is = 7: FractionalUnit = "Fils" Case Is = 8: FractionalUnit = "One Fils" End Select Fils = FractionalUnit End Function Public Function Centime(Num As Integer) Dim FractionalUnit As String: FractionalUnit = "Centime" Select Case Num ' Currency Information By Arabic Case Is = 1: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(237) & Chr(227) Case Is = 2: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(237) & Chr(227) & Chr(199) & Chr(228) Case Is = 3: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(237) & Chr(227) & Chr(199) & Chr(202) Case Is = 4: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(237) & Chr(227) & Chr(199) & Chr(240) ' Currency Information By Other Language Case Is = 5: FractionalUnit = "Centime" Case Is = 6: FractionalUnit = "Two Centimes" Case Is = 7: FractionalUnit = "Centimes" Case Is = 8: FractionalUnit = "One Centime" End Select Centime = FractionalUnit End Function Public Function Cent(Num As Integer) Dim FractionalUnit As String: FractionalUnit = "Cent" Select Case Num ' Currency Information By Arabic Case Is = 1: FractionalUnit = Chr(211) & Chr(228) & Chr(202) Case Is = 2: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(199) & Chr(228) Case Is = 3: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(199) & Chr(202) Case Is = 4: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(240) & Chr(199) ' Currency Information By Other Language Case Is = 5: FractionalUnit = "Cent" Case Is = 6: FractionalUnit = "Two Cents" Case Is = 7: FractionalUnit = "Cents" Case Is = 8: FractionalUnit = "One Cent" End Select Cent = FractionalUnit End Function '********************************************************************** ' Subroutine: UpdateCurrencyTable ' Purpose: Updates the tblCurrencyInfo table with currency information. ' Inputs: None. ' Outputs: None. ' Returns: None. ' Notes: - Retrieves an array of currency data and inserts or updates records in the database. ' - The function uses dynamic SQL to insert records into the table. ' - The `CurrencyYouWantToBeActive` function should return the currency that should be marked as active. ' - The `GetEgyptianPound`, `GetSaudiRiyal`, etc., functions should return currency information in a defined format. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Sub UpdateCurrencyTable() Dim db As DAO.Database Dim sql As String Dim sqlStart As String Dim sqlValues As String Dim currencies As Variant Dim i As Integer Dim activeCurrency As String ' Obtain a reference to the current database Set db = CurrentDb() ' Define the currency that should be active activeCurrency = CurrencyYouWantToBeActive() ' Replace with the name of the currency you want to be active ' Define an array of currencies with their respective values in Arabic and English, and active status currencies = Array( _ GetEgyptianPound(), _ GetSaudiRiyal(), _ GetQatariRiyal(), _ GetOmaniRial(), _ GetBahrainiDinar(), _ GetMoroccanDirham(), _ GetTunisianDinar(), _ GetAlgerianDinar(), _ GetIraqiDinar()) ' SQL statement parts sqlStart = "INSERT INTO tblCurrencyInfo " & _ "([IsCurrencyActive], [CurrencyNameSingular], [CurrencyNameDual], [CurrencyNamePlural], [CurrencyNameAccusative], [CurrencyBaseValue], " & _ "[FractionalUnitSingular], [FractionalUnitDual], [FractionalUnitPlural], [FractionalUnitAccusative], [FractionalUnitBaseValue], " & _ "[CurrencyNameSingularOtherLang], [CurrencyNameDualOtherLang], [CurrencyNamePluralOtherLang], [CurrencyNameAccusativeOtherLang], [CurrencyBaseValueOtherLang], " & _ "[FractionalUnitSingularOtherLang], [FractionalUnitDualOtherLang], [FractionalUnitPluralOtherLang], [FractionalUnitAccusativeOtherLang], [FractionalUnitBaseValueOtherLang], " & _ "[CurrencyISOCode], [NumberOfDecimalPlaces], [isCurrencyFeminine]) " & _ "VALUES (" ' Iterate through the array and insert each record into the table For i = LBound(currencies) To UBound(currencies) ' Debug: Print index and values for inspection ' Dim j As Integer ' Debug.Print "currencies(" & i & ")(" & j & "): " & currencies(i)(j) ' Debug.Print "Processing row " & i ' Construct the VALUES part of the SQL statement sqlValues = IIf(currencies(i)(0) = activeCurrency, "True", "False") & ", " & _ "'" & currencies(i)(0) & "', " & _ "'" & currencies(i)(1) & "', " & _ "'" & currencies(i)(2) & "', " & _ "'" & currencies(i)(3) & "', " & _ "'" & currencies(i)(4) & "', " & _ "'" & Nz(currencies(i)(5)) & "', " & _ "'" & Nz(currencies(i)(6)) & "', " & _ "'" & Nz(currencies(i)(7)) & "', " & _ "'" & Nz(currencies(i)(8)) & "', " & _ "'" & currencies(i)(9) & "', " & _ "'" & currencies(i)(10) & "', " & _ "'" & currencies(i)(11) & "', " & _ "'" & currencies(i)(12) & "', " & _ "'" & currencies(i)(13) & "', " & _ "'" & currencies(i)(14) & "', " & _ "'" & currencies(i)(15) & "', " & _ "'" & currencies(i)(16) & "', " & _ "'" & currencies(i)(17) & "', " & _ "'" & currencies(i)(18) & "', " & _ "'" & currencies(i)(19) & "', " & _ "'" & currencies(i)(20) & "', " & _ "'" & currencies(i)(21) & "', " & _ IIf(currencies(i)(22), "True", "False") ' Set isCurrencyFeminine value ' Combine SQL parts sql = sqlStart & sqlValues & ");" ' Debug: Print the SQL statement for inspection ' Debug.Print sql ' Execute the SQL statement db.Execute sql Next i ' Clean up sqlStart = "" Set db = Nothing End Sub ' array '********************************************************************** ' Function: GetEgyptianPound ' Purpose: Returns an array containing detailed information about the Egyptian Pound in both Arabic and English. ' Inputs: None. ' Outputs: None. ' Returns: Variant - An array containing: ' [0] - CurrencyNameSingular (Arabic) ' [1] - CurrencyNameDual (Arabic) ' [2] - CurrencyNamePlural (Arabic) ' [3] - CurrencyNameAccusative (Arabic) ' [4] - CurrencyBaseValue (Arabic) ' [5] - FractionalUnitSingular (Arabic) ' [6] - FractionalUnitDual (Arabic) ' [7] - FractionalUnitPlural (Arabic) ' [8] - FractionalUnitAccusative (Arabic) ' [9] - FractionalUnitBaseValue (Arabic) ' [10] - CurrencyNameSingularOtherLang (English) ' [11] - CurrencyNameDualOtherLang (English) ' [12] - CurrencyNamePluralOtherLang (English) ' [13] - CurrencyNameAccusativeOtherLang (English) ' [14] - CurrencyBaseValue (English) ' [15] - FractionalUnitSingularOtherLang (English) ' [16] - FractionalUnitDualOtherLang (English) ' [17] - FractionalUnitPluralOtherLang (English) ' [18] - FractionalUnitAccusativeOtherLang (English) ' [19] - FractionalUnitBaseValue (English) ' [20] - CurrencyISOCode (EGP) ' [21] - NumberOfDecimalPlaces (2) ' [22] - isCurrencyFeminine (Boolean) ' Notes: - The function utilizes `Piastre` to obtain the fractional unit names. ' - The `CleanUpVariables` subroutine is called at the end to reset the variables. ' - The returned array is structured for easy insertion into a database or use in other calculations. '********************************************************************** ' Author: Mohammed Essam, www.officena.net ' Contact: soul-angel@msn.com ' Date: August 2024 '********************************************************************** Function GetEgyptianPound() As Variant ' Currency Information By Arabic CurrencyNameSingular = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(32) & Chr(227) & Chr(213) & Chr(209) & Chr(237) CurrencyNameDual = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(199) & Chr(228) & Chr(32) & Chr(227) & Chr(213) & Chr(209) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(199) & Chr(202) & Chr(32) & Chr(227) & Chr(213) & Chr(209) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(240) & Chr(199) & Chr(32) & Chr(227) & Chr(213) & Chr(209) & Chr(237) & Chr(240) & Chr(199) FractionalUnitSingular = Piastre(1) FractionalUnitDual = Piastre(2) FractionalUnitPlural = Piastre(3) FractionalUnitAccusative = Piastre(4) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Egyptian Pound" CurrencyNameDualOtherLang = "Two Egyptian Pounds" CurrencyNamePluralOtherLang = "Egyptian Pounds" CurrencyNameAccusativeOtherLang = "One Egyptian Pound" FractionalUnitSingularOtherLang = Piastre(5) FractionalUnitDualOtherLang = Piastre(6) FractionalUnitPluralOtherLang = Piastre(7) FractionalUnitAccusativeOtherLang = Piastre(8) CurrencyISOCode = "EGP" NumberOfDecimalPlaces = 2 isCurrencyFeminine = False CurrencyBaseValue = 0 FractionalUnitBaseValue = 0 GetEgyptianPound = Array(CurrencyNameSingular, _ CurrencyNameDual, _ CurrencyNamePlural, _ CurrencyNameAccusative, _ CurrencyBaseValue, _ FractionalUnitSingular, _ FractionalUnitDual, _ FractionalUnitPlural, _ FractionalUnitAccusative, _ FractionalUnitBaseValue, _ CurrencyNameSingularOtherLang, _ CurrencyNameDualOtherLang, _ CurrencyNamePluralOtherLang, _ CurrencyNameAccusativeOtherLang, _ CurrencyBaseValue, _ FractionalUnitSingularOtherLang, _ FractionalUnitDualOtherLang, _ FractionalUnitPluralOtherLang, _ FractionalUnitAccusativeOtherLang, _ FractionalUnitBaseValue, _ CurrencyISOCode, _ NumberOfDecimalPlaces, _ isCurrencyFeminine) ' Clean up CleanUpVariables End Function Function GetSaudiRiyal() As Variant ' Currency Information By Arabic CurrencyNameSingular = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(32) & Chr(211) & Chr(218) & Chr(230) & Chr(207) & Chr(237) CurrencyNameDual = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(199) & Chr(228) & Chr(32) & Chr(211) & Chr(218) & Chr(230) & Chr(207) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(199) & Chr(202) & Chr(32) & Chr(211) & Chr(218) & Chr(230) & Chr(207) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(240) & Chr(199) & Chr(32) & Chr(211) & Chr(218) & Chr(230) & Chr(207) & Chr(237) & Chr(240) & Chr(199) FractionalUnitSingular = Chr(229) & Chr(225) & Chr(225) & Chr(201) FractionalUnitDual = Chr(229) & Chr(225) & Chr(225) & Chr(202) & Chr(199) & Chr(228) FractionalUnitPlural = Chr(229) & Chr(225) & Chr(225) & Chr(199) & Chr(202) FractionalUnitAccusative = Chr(229) & Chr(225) & Chr(225) & Chr(201) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Saudi Riyal" CurrencyNameDualOtherLang = "Two Saudi Riyals" CurrencyNamePluralOtherLang = "Saudi Riyals" CurrencyNameAccusativeOtherLang = "One Saudi Riyal" FractionalUnitSingularOtherLang = "Halala" FractionalUnitDualOtherLang = "Two Halalas" FractionalUnitPluralOtherLang = "Halalas" FractionalUnitAccusativeOtherLang = "One Halala" CurrencyISOCode = "SAR" NumberOfDecimalPlaces = 2 isCurrencyFeminine = True CurrencyBaseValue = 1 FractionalUnitBaseValue = 0 GetSaudiRiyal = Array(CurrencyNameSingular, _ CurrencyNameDual, _ CurrencyNamePlural, _ CurrencyNameAccusative, _ CurrencyBaseValue, _ FractionalUnitSingular, _ FractionalUnitDual, _ FractionalUnitPlural, _ FractionalUnitAccusative, _ FractionalUnitBaseValue, _ CurrencyNameSingularOtherLang, _ CurrencyNameDualOtherLang, _ CurrencyNamePluralOtherLang, _ CurrencyNameAccusativeOtherLang, _ CurrencyBaseValue, _ FractionalUnitSingularOtherLang, _ FractionalUnitDualOtherLang, _ FractionalUnitPluralOtherLang, _ FractionalUnitAccusativeOtherLang, _ FractionalUnitBaseValue, _ CurrencyISOCode, _ NumberOfDecimalPlaces, _ isCurrencyFeminine) ' Clean up CleanUpVariables End Function Function GetQatariRiyal() As Variant ' Currency Information By Arabic CurrencyNameSingular = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(32) & Chr(222) & Chr(216) & Chr(209) & Chr(237) CurrencyNameDual = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(199) & Chr(228) & Chr(32) & Chr(222) & Chr(216) & Chr(209) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(199) & Chr(202) & Chr(32) & Chr(222) & Chr(216) & Chr(209) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(240) & Chr(199) & Chr(32) & Chr(222) & Chr(216) & Chr(209) & Chr(237) & Chr(240) & Chr(199) FractionalUnitSingular = Dirham(1) FractionalUnitDual = Dirham(2) FractionalUnitPlural = Dirham(3) FractionalUnitAccusative = Dirham(4) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Qatari Riyal" CurrencyNameDualOtherLang = "Two Qatari Riyals" CurrencyNamePluralOtherLang = "Qatari Riyals" CurrencyNameAccusativeOtherLang = "One Qatari Riyal" FractionalUnitSingularOtherLang = Dirham(5) FractionalUnitDualOtherLang = Dirham(6) FractionalUnitPluralOtherLang = Dirham(7) FractionalUnitAccusativeOtherLang = Dirham(8) CurrencyISOCode = "QAR" NumberOfDecimalPlaces = 2 isCurrencyFeminine = False CurrencyBaseValue = 1 FractionalUnitBaseValue = 0 GetQatariRiyal = Array(CurrencyNameSingular, _ CurrencyNameDual, _ CurrencyNamePlural, _ CurrencyNameAccusative, _ CurrencyBaseValue, _ FractionalUnitSingular, _ FractionalUnitDual, _ FractionalUnitPlural, _ FractionalUnitAccusative, _ FractionalUnitBaseValue, _ CurrencyNameSingularOtherLang, _ CurrencyNameDualOtherLang, _ CurrencyNamePluralOtherLang, _ CurrencyNameAccusativeOtherLang, _ CurrencyBaseValue, _ FractionalUnitSingularOtherLang, _ FractionalUnitDualOtherLang, _ FractionalUnitPluralOtherLang, _ FractionalUnitAccusativeOtherLang, _ FractionalUnitBaseValue, _ CurrencyISOCode, _ NumberOfDecimalPlaces, _ isCurrencyFeminine) ' Clean up CleanUpVariables End Function Function GetBahrainiDinar() As Variant ' Currency Information By Arabic CurrencyNameSingular = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(32) & Chr(200) & Chr(205) & Chr(209) & Chr(237) & Chr(228) & Chr(237) CurrencyNameDual = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(199) & Chr(228) & Chr(32) & Chr(200) & Chr(205) & Chr(209) & Chr(237) & Chr(228) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(207) & Chr(228) & Chr(199) & Chr(228) & Chr(237) & Chr(209) & Chr(32) & Chr(200) & Chr(205) & Chr(209) & Chr(237) & Chr(228) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(240) & Chr(199) & Chr(32) & Chr(200) & Chr(205) & Chr(209) & Chr(237) & Chr(228) & Chr(237) & Chr(240) & Chr(199) FractionalUnitSingular = Fils(1) FractionalUnitDual = Fils(2) FractionalUnitPlural = Fils(3) FractionalUnitAccusative = Fils(4) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Bahraini Dinar" CurrencyNameDualOtherLang = "Two Bahraini Dinars" CurrencyNamePluralOtherLang = "Bahraini Dinars" CurrencyNameAccusativeOtherLang = "One Bahraini Dinar" FractionalUnitSingularOtherLang = Fils(5) FractionalUnitDualOtherLang = Fils(6) FractionalUnitPluralOtherLang = Fils(7) FractionalUnitAccusativeOtherLang = Fils(8) CurrencyISOCode = "BHD" NumberOfDecimalPlaces = 3 isCurrencyFeminine = False CurrencyBaseValue = 1 FractionalUnitBaseValue = 0 GetBahrainiDinar = Array(CurrencyNameSingular, _ CurrencyNameDual, _ CurrencyNamePlural, _ CurrencyNameAccusative, _ CurrencyBaseValue, _ FractionalUnitSingular, _ FractionalUnitDual, _ FractionalUnitPlural, _ FractionalUnitAccusative, _ FractionalUnitBaseValue, _ CurrencyNameSingularOtherLang, _ CurrencyNameDualOtherLang, _ CurrencyNamePluralOtherLang, _ CurrencyNameAccusativeOtherLang, _ CurrencyBaseValue, _ FractionalUnitSingularOtherLang, _ FractionalUnitDualOtherLang, _ FractionalUnitPluralOtherLang, _ FractionalUnitAccusativeOtherLang, _ FractionalUnitBaseValue, _ CurrencyISOCode, _ NumberOfDecimalPlaces, _ isCurrencyFeminine) ' Clean up CleanUpVariables End Function Function GetOmaniRial() As Variant ' Currency Information By Arabic CurrencyNameSingular = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(32) & Chr(218) & Chr(227) & Chr(199) & Chr(228) & Chr(237) CurrencyNameDual = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(199) & Chr(228) & Chr(32) & Chr(218) & Chr(227) & Chr(199) & Chr(228) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(199) & Chr(202) & Chr(32) & Chr(218) & Chr(227) & Chr(199) & Chr(228) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(240) & Chr(199) & Chr(32) & Chr(218) & Chr(227) & Chr(199) & Chr(228) & Chr(237) & Chr(240) & Chr(199) FractionalUnitSingular = Chr(200) & Chr(237) & Chr(211) & Chr(201) FractionalUnitDual = Chr(200) & Chr(237) & Chr(211) & Chr(202) & Chr(199) & Chr(228) FractionalUnitPlural = Chr(200) & Chr(237) & Chr(211) & Chr(199) & Chr(202) FractionalUnitAccusative = Chr(200) & Chr(237) & Chr(211) & Chr(201) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Omani Rial" CurrencyNameDualOtherLang = "Two Omani Rials" CurrencyNamePluralOtherLang = "Omani Rials" CurrencyNameAccusativeOtherLang = "One Omani Rial" FractionalUnitSingularOtherLang = "Baisa" FractionalUnitDualOtherLang = "Two Baisas" FractionalUnitPluralOtherLang = "Baisas" FractionalUnitAccusativeOtherLang = "One Baisa|" CurrencyISOCode = "OMR" NumberOfDecimalPlaces = 3 isCurrencyFeminine = True CurrencyBaseValue = 1 FractionalUnitBaseValue = 0 GetOmaniRial = Array(CurrencyNameSingular, _ CurrencyNameDual, _ CurrencyNamePlural, _ CurrencyNameAccusative, _ CurrencyBaseValue, _ FractionalUnitSingular, _ FractionalUnitDual, _ FractionalUnitPlural, _ FractionalUnitAccusative, _ FractionalUnitBaseValue, _ CurrencyNameSingularOtherLang, _ CurrencyNameDualOtherLang, _ CurrencyNamePluralOtherLang, _ CurrencyNameAccusativeOtherLang, _ CurrencyBaseValue, _ FractionalUnitSingularOtherLang, _ FractionalUnitDualOtherLang, _ FractionalUnitPluralOtherLang, _ FractionalUnitAccusativeOtherLang, _ FractionalUnitBaseValue, _ CurrencyISOCode, _ NumberOfDecimalPlaces, _ isCurrencyFeminine) ' Clean up CleanUpVariables End Function Function GetMoroccanDirham() As Variant ' Currency Information By Arabic CurrencyNameSingular = Chr(207) & Chr(209) & Chr(229) & Chr(227) & Chr(32) & Chr(227) & Chr(219) & Chr(209) & Chr(200) & Chr(237) CurrencyNameDual = Chr(207) & Chr(209) & Chr(229) & Chr(227) & Chr(199) & Chr(228) & Chr(32) & Chr(227) & Chr(219) & Chr(209) & Chr(200) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(207) & Chr(209) & Chr(199) & Chr(229) & Chr(227) & Chr(32) & Chr(227) & Chr(219) & Chr(209) & Chr(200) & Chr(237) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(207) & Chr(209) & Chr(229) & Chr(227) & Chr(199) & Chr(240) & Chr(32) & Chr(227) & Chr(219) & Chr(209) & Chr(200) & Chr(237) & Chr(199) & Chr(240) FractionalUnitSingular = Centime(1) FractionalUnitDual = Centime(2) FractionalUnitPlural = Centime(3) FractionalUnitAccusative = Centime(4) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Moroccan Dirham" CurrencyNameDualOtherLang = "Two Moroccan Dirhams" CurrencyNamePluralOtherLang = "Moroccan Dirhams" CurrencyNameAccusativeOtherLang = "One Moroccan Dirham" FractionalUnitSingularOtherLang = Centime(5) FractionalUnitDualOtherLang = Centime(6) FractionalUnitPluralOtherLang = Centime(7) FractionalUnitAccusativeOtherLang = Centime(8) CurrencyISOCode = "MAD" NumberOfDecimalPlaces = 2 isCurrencyFeminine = False CurrencyBaseValue = 0 FractionalUnitBaseValue = 0 GetMoroccanDirham = Array(CurrencyNameSingular, _ CurrencyNameDual, _ CurrencyNamePlural, _ CurrencyNameAccusative, _ CurrencyBaseValue, _ FractionalUnitSingular, _ FractionalUnitDual, _ FractionalUnitPlural, _ FractionalUnitAccusative, _ FractionalUnitBaseValue, _ CurrencyNameSingularOtherLang, _ CurrencyNameDualOtherLang, _ CurrencyNamePluralOtherLang, _ CurrencyNameAccusativeOtherLang, _ CurrencyBaseValue, _ FractionalUnitSingularOtherLang, _ FractionalUnitDualOtherLang, _ FractionalUnitPluralOtherLang, _ FractionalUnitAccusativeOtherLang, _ FractionalUnitBaseValue, _ CurrencyISOCode, _ NumberOfDecimalPlaces, _ isCurrencyFeminine) ' Clean up CleanUpVariables End Function Function GetTunisianDinar() As Variant ' Currency Information By Arabic CurrencyNameSingular = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(32) & Chr(202) & Chr(230) & Chr(228) & Chr(211) & Chr(237) CurrencyNameDual = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(199) & Chr(228) & Chr(32) & Chr(202) & Chr(230) & Chr(228) & Chr(211) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(207) & Chr(228) & Chr(199) & Chr(228) & Chr(237) & Chr(209) & Chr(32) & Chr(202) & Chr(230) & Chr(228) & Chr(211) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(199) & Chr(240) & Chr(32) & Chr(202) & Chr(230) & Chr(228) & Chr(211) & Chr(237) & Chr(199) & Chr(240) FractionalUnitSingular = Chr(227) & Chr(225) & Chr(237) & Chr(227) FractionalUnitDual = Chr(227) & Chr(225) & Chr(237) & Chr(227) & Chr(199) & Chr(228) FractionalUnitPlural = Chr(227) & Chr(225) & Chr(237) & Chr(227) & Chr(199) & Chr(202) FractionalUnitAccusative = Chr(227) & Chr(225) & Chr(237) & Chr(227) & Chr(199) & Chr(240) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Tunisian Dinar" CurrencyNameDualOtherLang = "Two Tunisian Dinars" CurrencyNamePluralOtherLang = "Tunisian Dinars" CurrencyNameAccusativeOtherLang = "One Tunisian Dinar" FractionalUnitSingularOtherLang = "Millime" FractionalUnitDualOtherLang = "Two Millimes" FractionalUnitPluralOtherLang = "Millimes" FractionalUnitAccusativeOtherLang = "One Millime" CurrencyISOCode = "TND" NumberOfDecimalPlaces = 3 isCurrencyFeminine = False CurrencyBaseValue = 0 FractionalUnitBaseValue = 0 GetTunisianDinar = Array(CurrencyNameSingular, _ CurrencyNameDual, _ CurrencyNamePlural, _ CurrencyNameAccusative, _ CurrencyBaseValue, _ FractionalUnitSingular, _ FractionalUnitDual, _ FractionalUnitPlural, _ FractionalUnitAccusative, _ FractionalUnitBaseValue, _ CurrencyNameSingularOtherLang, _ CurrencyNameDualOtherLang, _ CurrencyNamePluralOtherLang, _ CurrencyNameAccusativeOtherLang, _ CurrencyBaseValue, _ FractionalUnitSingularOtherLang, _ FractionalUnitDualOtherLang, _ FractionalUnitPluralOtherLang, _ FractionalUnitAccusativeOtherLang, _ FractionalUnitBaseValue, _ CurrencyISOCode, _ NumberOfDecimalPlaces, _ isCurrencyFeminine) ' Clean up CleanUpVariables End Function Function GetAlgerianDinar() As Variant ' Currency Information By Arabic CurrencyNameSingular = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(32) & Chr(204) & Chr(210) & Chr(199) & Chr(198) & Chr(209) & Chr(237) CurrencyNameDual = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(199) & Chr(228) & Chr(32) & Chr(204) & Chr(210) & Chr(199) & Chr(198) & Chr(209) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(207) & Chr(228) & Chr(199) & Chr(228) & Chr(237) & Chr(209) & Chr(32) & Chr(204) & Chr(210) & Chr(199) & Chr(198) & Chr(209) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(199) & Chr(240) & Chr(32) & Chr(204) & Chr(210) & Chr(199) & Chr(198) & Chr(209) & Chr(237) & Chr(199) & Chr(240) FractionalUnitSingular = Chr(32) FractionalUnitDual = Chr(32) FractionalUnitPlural = Chr(32) FractionalUnitAccusative = Chr(32) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Algerian Dinar" CurrencyNameDualOtherLang = "Two Algerian Dinars" CurrencyNamePluralOtherLang = "Algerian Dinars" CurrencyNameAccusativeOtherLang = "One Algerian Dinar" FractionalUnitSingularOtherLang = Chr(32) FractionalUnitDualOtherLang = Chr(32) FractionalUnitPluralOtherLang = Chr(32) FractionalUnitAccusativeOtherLang = Chr(32) CurrencyISOCode = "DZD" NumberOfDecimalPlaces = 0 isCurrencyFeminine = False CurrencyBaseValue = 0 FractionalUnitBaseValue = 0 GetAlgerianDinar = Array(CurrencyNameSingular, _ CurrencyNameDual, _ CurrencyNamePlural, _ CurrencyNameAccusative, _ CurrencyBaseValue, _ FractionalUnitSingular, _ FractionalUnitDual, _ FractionalUnitPlural, _ FractionalUnitAccusative, _ FractionalUnitBaseValue, _ CurrencyNameSingularOtherLang, _ CurrencyNameDualOtherLang, _ CurrencyNamePluralOtherLang, _ CurrencyNameAccusativeOtherLang, _ CurrencyBaseValue, _ FractionalUnitSingularOtherLang, _ FractionalUnitDualOtherLang, _ FractionalUnitPluralOtherLang, _ FractionalUnitAccusativeOtherLang, _ FractionalUnitBaseValue, _ CurrencyISOCode, _ NumberOfDecimalPlaces, _ isCurrencyFeminine) ' Clean up CleanUpVariables End Function Function GetIraqiDinar() As Variant ' Currency Information By Arabic CurrencyNameSingular = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(32) & Chr(218) & Chr(209) & Chr(199) & Chr(222) & Chr(237) CurrencyNameDual = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(199) & Chr(228) & Chr(32) & Chr(218) & Chr(209) & Chr(199) & Chr(222) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(207) & Chr(228) & Chr(199) & Chr(228) & Chr(237) & Chr(209) & Chr(32) & Chr(218) & Chr(209) & Chr(199) & Chr(222) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(207) & Chr(237) & Chr(228) & Chr(199) & Chr(209) & Chr(199) & Chr(240) & Chr(32) & Chr(218) & Chr(209) & Chr(199) & Chr(222) & Chr(237) & Chr(199) & Chr(240) FractionalUnitSingular = Fils(1) FractionalUnitDual = Fils(2) FractionalUnitPlural = Fils(3) FractionalUnitAccusative = Fils(4) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Iraqi Dinar" CurrencyNameDualOtherLang = "Two Iraqi Dinars" CurrencyNamePluralOtherLang = "Iraqi Dinars" CurrencyNameAccusativeOtherLang = "One Iraqi Dinar" FractionalUnitSingularOtherLang = Fils(5) FractionalUnitDualOtherLang = Fils(6) FractionalUnitPluralOtherLang = Fils(7) FractionalUnitAccusativeOtherLang = Fils(8) CurrencyISOCode = "IQD" NumberOfDecimalPlaces = 3 isCurrencyFeminine = False CurrencyBaseValue = 0 FractionalUnitBaseValue = 0 GetIraqiDinar = Array(CurrencyNameSingular, _ CurrencyNameDual, _ CurrencyNamePlural, _ CurrencyNameAccusative, _ CurrencyBaseValue, _ FractionalUnitSingular, _ FractionalUnitDual, _ FractionalUnitPlural, _ FractionalUnitAccusative, _ FractionalUnitBaseValue, _ CurrencyNameSingularOtherLang, _ CurrencyNameDualOtherLang, _ CurrencyNamePluralOtherLang, _ CurrencyNameAccusativeOtherLang, _ CurrencyBaseValue, _ FractionalUnitSingularOtherLang, _ FractionalUnitDualOtherLang, _ FractionalUnitPluralOtherLang, _ FractionalUnitAccusativeOtherLang, _ FractionalUnitBaseValue, _ CurrencyISOCode, _ NumberOfDecimalPlaces, _ isCurrencyFeminine) ' Clean up CleanUpVariables End Function الوظيفبة الأولى : TableExists الغرض منها التحقق من وجود الجدول وفى حالة وجودة سوف يتم تجاهل دوال انشاء الجدول او اضافة البيانات الاساسية اليه. الوظيفبة التالية : CreateCurrencyTable الغرض منها إنشاء جدول جديد باسم "tblCurrencyInfo" مع حقول محددة مسبقًا في قاعدة البيانات الحالية ملاحظات: تقوم هذا الوظيفة الفرعية بتهيئة جدول جديد وتحديد الحقول الضرورية لتخزين معلومات العملات حيث تتضمن الحقول معلومات العملة القياسية والخاصة باللغة كما سيتم توضيحه . عند انشاء الجدول اضفت اكواد لتعديل خصائص الحقل بوضع التسمية المناسبة لكل حقل وكذلك الوصف تم تشفير كل الأحرف العربية داخل الوحدة النمطية لتكون بالـ Ascii وذلك حتى يتم التعرف على الحروف فى اى حاسوب بغض النظر عن اعدادات اللغة المستخدمة لمنع مشاكل اللغة والتى تعيق البعض من استخدام الاكواد ولذلك سوف اضع المرفق الاخر وهى اداة كنت قد قمت بتصميمها قبل فترة لتعمل على التحويل من والى الـ Ascii الوظيفبة التالية : CreateAndUpdateCurrencyTable الغرض منها استدعاء دوال انشاء الجدول ةإضافة ببيانات العملات لا اكثر ولا اقل من ذلك . الوظيفبة التالية : GetCurrencyValues الغرض منها استرداد قيم العملات من جدول "tblCurrencyInfo" استنادًا إلى العملة النشطة و المحددة للاستخدام من خلال الكود . المدخلات: اللغة اختيارية كسلسلة - "ar" (افتراضي) للغة العربية و"EN" للغة الإنجليزية الإرجاع: مجموعة من قيم العملات باللغة المحددة ملاحظات: - تتحقق الوظيفة مما إذا كان جدول "tblCurrencyInfo" موجودًا ومملوءًا بالعملات وبالاخص العملة النشطة - إذا لم يتم العثور على سجلات نشطة فإنها ترجع مجموعة من القيم الافتراضية - تعالج أخطاء الجدول المفقودة عن طريق استدعاء الدالة CreateAndUpdateCurrencyTable الوظيفبة التالية : ConvertToWords الغرض منها تحويل سلسلة رقمية إلى كلمات باللغة العربية أو الإنجليزية المدخلات: num - القيمة الرقمية كسلسلة currencyTerms - مجموعة من مصطلحات العملة للتحويل lang اختياري - لغة الهدف للتحويل (الإعداد الافتراضي هو "ar") الإرجاع: String - القيمة الرقمية بالكلمات ملاحظات: تدعم الوظيفة اللغتين الإنجليزية والعربية يتم تضمين النص العربي للوحدات الصغيرة ( كسر العملة) والوحدات الكبيرة لتحويل العملات وهى دالة مساعدة للدالة الاساسية التى يتم استدعائها وتتعامل بحرفية تامة مع كسر العملات حسب النوع الذكورى منها والانثوى الوظيفبة التالية : ConvertNumberToWords الغرض: تحويل سلسلة رقمية إلى تمثيلها اللفظي باللغة العربية أو الإنجليزية فهى الدالة الاساسية والتى ييتم استدعائها لاجراء عملية التحويل والتفقيط المدخلات: الرقم - القيمة الرقمية كسلسلة اللغة الاختيارية - اللغة المستهدفة للتحويل (الإعداد الافتراضي هو "ar") الإرجاع: السلسلة - القيمة الرقمية بالكلمات بتمثيلها اللفظي باللغة العربية أو الإنجليزية الملاحظات: يتم التعامل مع كل من الأجزاء الصحيحة و الكسرية للعملة ( العدد الرقمى) الوظيفبة التالية : CleanUpVariables الغرض منها منع تكرار الاكواد فقط ووظيفتها تفريغ قيم المتتغيرات بغرض تنظيف الذاكرة اما هذه الوظائف الاتية ' Constants of names of common currency fractions with more than one currency Public Function Piastre(num As Integer) Dim FractionalUnit As String: FractionalUnit = "Piastre" Select Case num ' Currency Information By Arabic Case Is = 1: FractionalUnit = Chr(222) & Chr(209) & Chr(212) Case Is = 2: FractionalUnit = Chr(222) & Chr(209) & Chr(212) & Chr(199) & Chr(228) Case Is = 3: FractionalUnit = Chr(222) & Chr(209) & Chr(230) & Chr(212) Case Is = 4: FractionalUnit = Chr(222) & Chr(209) & Chr(212) & Chr(199) & Chr(240) ' Currency Information By Other Language Case Is = 5: FractionalUnit = "Piastre" Case Is = 6: FractionalUnit = "Two Piastres" Case Is = 7: FractionalUnit = "Piastres" Case Is = 8: FractionalUnit = "One Piastre" End Select Piastre = FractionalUnit End Function Public Function Dirham(num As Integer) Dim FractionalUnit As String: FractionalUnit = "Dirham" Select Case num ' Currency Information By Arabic Case Is = 1: FractionalUnit = Chr(207) & Chr(209) & Chr(229) & Chr(227) Case Is = 2: FractionalUnit = Chr(207) & Chr(209) & Chr(229) & Chr(227) Case Is = 3: FractionalUnit = Chr(207) & Chr(209) & Chr(199) & Chr(229) & Chr(227) Case Is = 4: FractionalUnit = Chr(207) & Chr(209) & Chr(229) & Chr(227) & Chr(240) & Chr(199) ' Currency Information By Other Language Case Is = 5: FractionalUnit = "Dirham" Case Is = 6: FractionalUnit = "Two Dirhams" Case Is = 7: FractionalUnit = "Dirhams" Case Is = 8: FractionalUnit = "One Dirham" End Select Dirham = FractionalUnit End Function Public Function Fils(num As Integer) Dim FractionalUnit As String: FractionalUnit = "Fils" Select Case num ' Currency Information By Arabic Case Is = 1: FractionalUnit = Chr(221) & Chr(225) & Chr(211) Case Is = 2: FractionalUnit = Chr(221) & Chr(225) & Chr(211) & Chr(199) & Chr(228) Case Is = 3: FractionalUnit = Chr(221) & Chr(225) & Chr(230) & Chr(211) Case Is = 4: FractionalUnit = Chr(221) & Chr(225) & Chr(211) & Chr(240) & Chr(199) ' Currency Information By Other Language Case Is = 5: FractionalUnit = "Fils" Case Is = 6: FractionalUnit = "Two Fils" Case Is = 7: FractionalUnit = "Fils" Case Is = 8: FractionalUnit = "One Fils" End Select Fils = FractionalUnit End Function Public Function Centime(num As Integer) Dim FractionalUnit As String: FractionalUnit = "Centime" Select Case num ' Currency Information By Arabic Case Is = 1: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(237) & Chr(227) Case Is = 2: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(237) & Chr(227) & Chr(199) & Chr(228) Case Is = 3: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(237) & Chr(227) & Chr(199) & Chr(202) Case Is = 4: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(237) & Chr(227) & Chr(199) & Chr(240) ' Currency Information By Other Language Case Is = 5: FractionalUnit = "Centime" Case Is = 6: FractionalUnit = "Two Centimes" Case Is = 7: FractionalUnit = "Centimes" Case Is = 8: FractionalUnit = "One Centime" End Select Centime = FractionalUnit End Function Public Function Cent(num As Integer) Dim FractionalUnit As String: FractionalUnit = "Cent" Select Case num ' Currency Information By Arabic Case Is = 1: FractionalUnit = Chr(211) & Chr(228) & Chr(202) Case Is = 2: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(199) & Chr(228) Case Is = 3: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(199) & Chr(202) Case Is = 4: FractionalUnit = Chr(211) & Chr(228) & Chr(202) & Chr(240) & Chr(199) ' Currency Information By Other Language Case Is = 5: FractionalUnit = "Cent" Case Is = 6: FractionalUnit = "Two Cents" Case Is = 7: FractionalUnit = "Cents" Case Is = 8: FractionalUnit = "One Cent" End Select Cent = FractionalUnit End Function هى وظائف مساعدة لوظائف إضافة بيانات العملات داخل الجدول عند انشائه للمرة الاولى ملحوظة هامة : هى تخص فقط اجزاء العملات ( كسر العملة ) الطبيعى ان هذا الجزء موجود فى وظائف العملات ولكن اسم هذا الجزء ( كسر العملة ) لكل عملة هو مشترك بين العديد من العملات فبدلا من كثرة الكتابة وتكرار الاكواد قمت بفصلها على ان تكون وظائف مشتركة لتكتب مرة واحدة ولكن يتم استدعائها عند الحاجة مع العملات المشتركة مثل : فلس فهو يشترك مع كل من العملات الاتية دينار بحريني , دينار عراقي هذا على سبيل المثال وليس الحصر الان وصلنا الى الجزء الاخير الوظيفبة التالية : UpdateCurrencyTable الغرض منها : إضافة بيانات العملات الى الجدول هذه الدالة عبارة عن مصفوفة رئيسية متضمنة بداخلها مصفوفات فرعية كان شكل الكود كالتالى عندما كتبته فى المرة الاول Sub UpdateCurrencyTable() Dim db As DAO.Database Dim sql As String Dim currencies As Variant Dim i As Integer ' Obtain a reference to the current database Set db = CurrentDb() ' Define an array of currencies with their respective values in Arabic and English, and active status currencies = Array(Array("جنيه مصري", "جنيهان مصريان", "جنيهات مصرية", "جنيهًا مصريًا", "0", "قرش", "قرشان", "قروش", "قرشًا", "0", "Egyptian Pound", "Two Egyptian Pounds", "Egyptian Pounds", "One Egyptian Pound", "0", "Piastre", "Two Piastres", "Piastres", "One Piastre", "0", "EGP", 2, True), _ Array("دينار أردني", "ديناران أردنيان", "دنانير أردنية", "دينار أردني", "1", "قرش", "قرشان", "قروش", "قرش", "0", "Jordanian Dinar", "Two Jordanian Dinars", "Jordanian Dinars", "One Jordanian Dinar", "1", "Piastre", "Two Piastres", "Piastres", "One Piastre", "0", "JOD", 3, False), _ Array("دينار كويتي", "ديناران كويتيان", "دنانير كويتية", "دينار كويتي", "1", "فلس", "فلسان", "فلسات", "فلس", "0", "Kuwaiti Dinar", "Two Kuwaiti Dinars", "Kuwaiti Dinars", "One Kuwaiti Dinar", "1", "Fils", "Two Fils", "Fils", "One Fils", "0", "KWD", 3, False), _ Array("ريال سعودي", "ريالان سعوديان", "ريالات سعودية", "ريال سعودي", "1", "هللة", "هللتان", "هللات", "هللة", "0", "Saudi Riyal", "Two Saudi Riyals", "Saudi Riyals", "One Saudi Riyal", "1", "Halala", "Two Halalas", "Halalas", "One Halala", "0", "SAR", 2, False), _ Array("درهم إماراتي", "درهمان إماراتيان", "درهمات إماراتية", "درهم إماراتي", "1", "فلس", "فلسان", "فلسات", "فلس", "0", "UAE Dirham", "Two UAE Dirhams", "UAE Dirhams", "One UAE Dirham", "1", "Fils", "Two Fils", "Fils", "One Fils", "0", "AED", 2, False), _ Array("ريال قطري", "ريالان قطريان", "ريالات قطرية", "ريال قطري", "1", "درهم", "درهمان", "درهمات", "درهم", "0", "Qatari Riyal", "Two Qatari Riyals", "Qatari Riyals", "One Qatari Riyal", "1", "Dirham", "Two Dirhams", "Dirhams", "One Dirham", "0", "QAR", 2, False), _ Array("دينار بحريني", "ديناران بحرينيان", "دنانير بحرينية", "دينار بحريني", "1", "فلس", "فلسان", "فلسات", "فلس", "0", "Bahraini Dinar", "Two Bahraini Dinars", "Bahraini Dinars", "One Bahraini Dinar", "1", "Fils", "Two Fils", "Fils", "One Fils", "0", "BHD", 3, False), _ Array("ريال عماني", "ريالان عمانيان", "ريالات عمانية", "ريال عماني", "1", "بيسة", "بيستان", "بيسات", "بيسة", "0", "Omani Rial", "Two Omani Rials", "Omani Rials", "One Omani Rial", "1", "Baisa", "Two Baisas", "Baisas", "One Baisa", "0", "OMR", 3, False), _ Array("دولار أمريكي", "دولارين أمريكيين", "دولارات أمريكية", "دولار أمريكي", "1", "سنت", "سنتان", "سنتات", "سنت", "0", "US Dollar", "Two US Dollars", "US Dollars", "One US Dollar", "1", "Cent", "Two Cents", "Cents", "One Cent", "0", "USD", 2, False), _ Array("يورو", "يوروين", "يوروهات", "يورو", "1", "سنت", "سنتان", "سنتات", "سنت", "0", "Euro", "Two Euros", "Euros", "One Euro", "1", "Cent", "Two Cents", "Cents", "One Cent", "0", "EUR", 2, False), _ Array("جنيه إسترليني", "جنيهان إسترلينيان", "جنيهات إسترلينية", "جنيه إسترليني", "1", "بيني", "بينيان", "بنسات", "بيني", "0", "British Pound", "Two British Pounds", "British Pounds", "One British Pound", "1", "Penny", "Two Pennies", "Pennies", "One Penny", "0", "GBP", 2, False), _ Array("ين ياباني", "ينان يابانيان", "ينات يابانية", "ين ياباني", "1", "سين", "سنان", "سينات", "سين", "0", "Japanese Yen", "Two Japanese Yens", "Japanese Yens", "One Japanese Yen", "1", "Sen", "Two Sens", "Sens", "One Sen", "0", "JPY", 0, False), _ Array("دولار كندي", "دولارين كنديين", "دولارات كندية", "دولار كندي", "1", "سنت", "سنتان", "سنتات", "سنت", "0", "Canadian Dollar", "Two Canadian Dollars", "Canadian Dollars", "One Canadian Dollar", "1", "Cent", "Two Cents", "Cents", "One Cent", "0", "CAD", 2, False), _ Array("دولار أسترالي", "دولارين أستراليين", "دولارات أسترالية", "دولار أسترالي", "1", "سنت", "سنتان", "سنتات", "سنت", "0", "Australian Dollar", "Two Australian Dollars", "Australian Dollars", "One Australian Dollar", "1", "Cent", "Two Cents", "Cents", "One Cent", "0", "AUD", 2, False), _ Array("فرنك سويسري", "فرنكان سويسريان", "فرنكات سويسرية", "فرنك سويسري", "1", "رابن", "رابنان", "رابنات", "رابن", "0", "Swiss Franc", "Two Swiss Francs", "Swiss Francs", "One Swiss Franc", "1", "Rappen", "Two Rappen", "Rappen", "One Rappen", "0", "CHF", 2, False), _ Array("يوان صيني", "يوانان صينيان", "يوانات صينية", "يوان صيني", "1", "فن", "فنان", "فنانات", "فن", "0", "Chinese Yuan", "Two Chinese Yuan", "Chinese Yuan", "One Chinese Yuan", "1", "Fen", "Two Fens", "Fens", "One Fen", "0", "CNY", 2, False), _ Array("كرونة سويدية", "كرونتان سويديان", "كرونات سويدية", "كرونة سويدية", "1", "أوره", "أورهات", "أورهات", "أوره", "0", "Swedish Krona", "Two Swedish Kronor", "Swedish Kronor", "One Swedish Krona", "1", "Kr", "Two Kr", "Kronor", "One Kr", "0", "SEK", 2, False), _ Array("دولار نيوزيلندي", "دولارين نيوزيلنديين", "دولارات نيوزيلندية", "دولار نيوزيلندي", "1", "سنت", "سنتان", "سنتات", "سنت", "0", "New Zealand Dollar", "Two New Zealand Dollars", "New Zealand Dollars", "One New Zealand Dollar", "1", "Cent", "Two Cents", "Cents", "One Cent", "0", "NZD", 2, False)) ' Iterate through the array and insert each record into the table For i = LBound(currencies) To UBound(currencies) sql = "INSERT INTO tblCurrencyInfo ([CurrencyNameSingular], [CurrencyNameDual], [CurrencyNamePlural], [CurrencyNameAccusative], [CurrencyBaseValue], [PiastreNameSingular], [PiastreNameDual], [PiastreNamePlural], [PiastreNameAccusative], [PiastreBaseValue], " & _ "[CurrencyNameSingularOtherLang], [CurrencyNameDualOtherLang], [CurrencyNamePluralOtherLang], [CurrencyNameAccusativeOtherLang], [CurrencyBaseValueOtherLang], [PiastreNameSingularOtherLang], [PiastreNameDualOtherLang], [PiastreNamePluralOtherLang], [PiastreNameAccusativeOtherLang], [PiastreBaseValueOtherLang], [CurrencyISOCode], [NumberOfDecimalPlaces], [IsCurrencyActive]) " & _ "VALUES ('" & currencies(i)(0) & "', '" & currencies(i)(1) & "', '" & currencies(i)(2) & "', '" & currencies(i)(3) & "', '" & currencies(i)(4) & "', " & _ "'" & currencies(i)(5) & "', '" & currencies(i)(6) & "', '" & currencies(i)(7) & "', '" & currencies(i)(8) & "', '" & currencies(i)(9) & "', " & _ "'" & currencies(i)(10) & "', '" & currencies(i)(11) & "', '" & currencies(i)(12) & "', '" & currencies(i)(13) & "', '" & currencies(i)(14) & "', " & _ "'" & currencies(i)(15) & "', '" & currencies(i)(16) & "', '" & currencies(i)(17) & "', '" & currencies(i)(18) & "', '" & currencies(i)(19) & "', " & _ "'" & currencies(i)(20) & "', " & currencies(i)(21) & ", " & currencies(i)(22) & ");" db.Execute sql Next i ' Clean up Set db = Nothing End Sub وهنا كانت الفاجعة التحدى الاول و الأصعب لأنه فوجئت بشئ لم أكن أعلم عنه وهو أن الاكسس لا يمنحك عدد اسطر لا نهائية لكتابة اى وظيفة او روتين فوجئت ان هناك عدد من الاسطر محددة والتى لن يقبل منك محرر الاكواد اى شئ بعد الوصول اليها واستفاذ المجال المسموح به التحدى الثانى : دائما اتعب نفسي فى بداية تحليل النظام واكثر من ذلك عند كتابة الأكواد لأنه دائما وأبدا لا أفكر فى التعب عند وضع حجر الاساس فكل ما يشغل بالى ويهمنى هو المحصلة النهائية لتكون فى منتهى السهولة والمرونة اثناء التعامل مع المستخدم زى ما بيقول الفرنحة الـ End User لذلك كان التحدى هو كيف يتم تسهيل اضافة او تعديل العملات بالاضافة او بالحذف او بالتعديل طبعا الدالة السابقة وكما تشاهدون الموضوع صعب حبيتن و بما ان هذه مصفوفات لابد من التعامل معها بحذر فى الترتيب عند ادخال البينات التحدى الثالث : تحدى اكبر واصعب تشفير الحروف العربية الى Ascii وانا اقصد هنا بالأخص داخل المصفوفات لأنه سوف يزيد من حجم الكود وعدد الاسطر وبعد جهد وعناء شديدين فكرت فى فصل المصفوفات الفرعية للعملات على ان تكون لكل عملة مصفوفة خاصة بها ليتم كتابة كود المصوفة الرئيسية فى وظيفة منفصلة على ان يتم فيها فقط تجميع المصفوفات الفرعية للعملات من خلال استدعاء كل وظيفة وبذلك يكون كود المصفوفة الرئسية Sub UpdateCurrencyTable() Dim db As DAO.Database Dim sql As String Dim sqlStart As String Dim sqlValues As String Dim currencies As Variant Dim i As Integer Dim activeCurrency As String ' Obtain a reference to the current database Set db = CurrentDb() ' Define the currency that should be active activeCurrency = CurrencyYouWantToBeActive() ' Replace with the name of the currency you want to be active ' Define an array of currencies with their respective values in Arabic and English, and active status currencies = Array( _ GetEgyptianPound(), _ GetSaudiRiyal(), _ GetQatariRiyal(), _ GetOmaniRial(), _ GetBahrainiDinar(), _ GetMoroccanDirham(), _ GetTunisianDinar(), _ GetAlgerianDinar(), _ GetIraqiDinar()) ' SQL statement parts sqlStart = "INSERT INTO tblCurrencyInfo " & _ "([IsCurrencyActive], [CurrencyNameSingular], [CurrencyNameDual], [CurrencyNamePlural], [CurrencyNameAccusative], [CurrencyBaseValue], " & _ "[FractionalUnitSingular], [FractionalUnitDual], [FractionalUnitPlural], [FractionalUnitAccusative], [FractionalUnitBaseValue], " & _ "[CurrencyNameSingularOtherLang], [CurrencyNameDualOtherLang], [CurrencyNamePluralOtherLang], [CurrencyNameAccusativeOtherLang], [CurrencyBaseValueOtherLang], " & _ "[FractionalUnitSingularOtherLang], [FractionalUnitDualOtherLang], [FractionalUnitPluralOtherLang], [FractionalUnitAccusativeOtherLang], [FractionalUnitBaseValueOtherLang], " & _ "[CurrencyISOCode], [NumberOfDecimalPlaces], [isCurrencyFeminine]) " & _ "VALUES (" ' Iterate through the array and insert each record into the table For i = LBound(currencies) To UBound(currencies) ' Debug: Print index and values for inspection ' Dim j As Integer ' Debug.Print "currencies(" & i & ")(" & j & "): " & currencies(i)(j) ' Debug.Print "Processing row " & i ' Construct the VALUES part of the SQL statement sqlValues = IIf(currencies(i)(0) = activeCurrency, "True", "False") & ", " & _ "'" & currencies(i)(0) & "', " & _ "'" & currencies(i)(1) & "', " & _ "'" & currencies(i)(2) & "', " & _ "'" & currencies(i)(3) & "', " & _ "'" & currencies(i)(4) & "', " & _ "'" & Nz(currencies(i)(5)) & "', " & _ "'" & Nz(currencies(i)(6)) & "', " & _ "'" & Nz(currencies(i)(7)) & "', " & _ "'" & Nz(currencies(i)(8)) & "', " & _ "'" & currencies(i)(9) & "', " & _ "'" & currencies(i)(10) & "', " & _ "'" & currencies(i)(11) & "', " & _ "'" & currencies(i)(12) & "', " & _ "'" & currencies(i)(13) & "', " & _ "'" & currencies(i)(14) & "', " & _ "'" & currencies(i)(15) & "', " & _ "'" & currencies(i)(16) & "', " & _ "'" & currencies(i)(17) & "', " & _ "'" & currencies(i)(18) & "', " & _ "'" & currencies(i)(19) & "', " & _ "'" & currencies(i)(20) & "', " & _ "'" & currencies(i)(21) & "', " & _ IIf(currencies(i)(22), "True", "False") ' Set isCurrencyFeminine value ' Combine SQL parts sql = sqlStart & sqlValues & ");" ' Debug: Print the SQL statement for inspection ' Debug.Print sql ' Execute the SQL statement db.Execute sql Next i ' Clean up sqlStart = "" Set db = Nothing End Sub سنعود اليه قريبا.... الان المصفوفات الفرعية للعملات وهى هنا نوعان : النوع الاول : والذى يعتمد على اسماء كسر عملات مشتركة بين اكثر من عملة والتى تم التنويه عنها قبل قليل Function GetEgyptianPound() As Variant ' Currency Information By Arabic CurrencyNameSingular = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(32) & Chr(227) & Chr(213) & Chr(209) & Chr(237) CurrencyNameDual = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(199) & Chr(228) & Chr(32) & Chr(227) & Chr(213) & Chr(209) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(199) & Chr(202) & Chr(32) & Chr(227) & Chr(213) & Chr(209) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(204) & Chr(228) & Chr(237) & Chr(229) & Chr(240) & Chr(199) & Chr(32) & Chr(227) & Chr(213) & Chr(209) & Chr(237) & Chr(240) & Chr(199) FractionalUnitSingular = Piastre(1) FractionalUnitDual = Piastre(2) FractionalUnitPlural = Piastre(3) FractionalUnitAccusative = Piastre(4) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Egyptian Pound" CurrencyNameDualOtherLang = "Two Egyptian Pounds" CurrencyNamePluralOtherLang = "Egyptian Pounds" CurrencyNameAccusativeOtherLang = "One Egyptian Pound" FractionalUnitSingularOtherLang = Piastre(5) FractionalUnitDualOtherLang = Piastre(6) FractionalUnitPluralOtherLang = Piastre(7) FractionalUnitAccusativeOtherLang = Piastre(8) CurrencyISOCode = "EGP" NumberOfDecimalPlaces = 2 isCurrencyFeminine = False CurrencyBaseValue = 0 FractionalUnitBaseValue = 0 GetEgyptianPound = Array(CurrencyNameSingular, _ CurrencyNameDual, _ CurrencyNamePlural, _ CurrencyNameAccusative, _ CurrencyBaseValue, _ FractionalUnitSingular, _ FractionalUnitDual, _ FractionalUnitPlural, _ FractionalUnitAccusative, _ FractionalUnitBaseValue, _ CurrencyNameSingularOtherLang, _ CurrencyNameDualOtherLang, _ CurrencyNamePluralOtherLang, _ CurrencyNameAccusativeOtherLang, _ CurrencyBaseValue, _ FractionalUnitSingularOtherLang, _ FractionalUnitDualOtherLang, _ FractionalUnitPluralOtherLang, _ FractionalUnitAccusativeOtherLang, _ FractionalUnitBaseValue, _ CurrencyISOCode, _ NumberOfDecimalPlaces, _ isCurrencyFeminine) ' Clean up CleanUpVariables End Function فكما تلاحظون على سبيل المثال فى هذه الاسطر FractionalUnitSingular = Piastre(1) FractionalUnitDual = Piastre(2) FractionalUnitPlural = Piastre(3) FractionalUnitAccusative = Piastre(4) ان نوع كسر العملة اذا كان مفردا او مثنى او جمع تم تعريفة من خلال الوظيفة Piastre وبين قويسن الرقم الذى يدل على هذا النوع تبعا للوظيفة التى تم انشائها مسبقا النوع الثانى تم كتابة كل البيانات بدون الاعتماد على اى وظائف او دوال مساعدة اخرى مثل ' Currency Information By Arabic CurrencyNameSingular = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(32) & Chr(211) & Chr(218) & Chr(230) & Chr(207) & Chr(237) CurrencyNameDual = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(199) & Chr(228) & Chr(32) & Chr(211) & Chr(218) & Chr(230) & Chr(207) & Chr(237) & Chr(199) & Chr(228) CurrencyNamePlural = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(199) & Chr(202) & Chr(32) & Chr(211) & Chr(218) & Chr(230) & Chr(207) & Chr(237) & Chr(201) CurrencyNameAccusative = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(240) & Chr(199) & Chr(32) & Chr(211) & Chr(218) & Chr(230) & Chr(207) & Chr(237) & Chr(240) & Chr(199) FractionalUnitSingular = Chr(229) & Chr(225) & Chr(225) & Chr(201) FractionalUnitDual = Chr(229) & Chr(225) & Chr(225) & Chr(202) & Chr(199) & Chr(228) FractionalUnitPlural = Chr(229) & Chr(225) & Chr(225) & Chr(199) & Chr(202) FractionalUnitAccusative = Chr(229) & Chr(225) & Chr(225) & Chr(201) ' Currency Information By Other Language CurrencyNameSingularOtherLang = "Saudi Riyal" CurrencyNameDualOtherLang = "Two Saudi Riyals" CurrencyNamePluralOtherLang = "Saudi Riyals" CurrencyNameAccusativeOtherLang = "One Saudi Riyal" FractionalUnitSingularOtherLang = "Halala" FractionalUnitDualOtherLang = "Two Halalas" FractionalUnitPluralOtherLang = "Halalas" FractionalUnitAccusativeOtherLang = "One Halala" CurrencyISOCode = "SAR" NumberOfDecimalPlaces = 2 isCurrencyFeminine = True CurrencyBaseValue = 1 FractionalUnitBaseValue = 0 ما يهمنا هنا هو النصف الاول وهو اختيار اسم الوظيفة باسم العملات وضع البيانات للعملات فى المتفيرات وهذه المتغيرات هى وكما هو موضح بالجدول الخاص بنوع العملات اسم العملة بصيغة المفرد اسم العملة بصيغة المثنى اسم العملة بصيغة الجمع اسم العملة بصيغة حالة النصب القيمة الأساسية للعملة وهى اما 0 او 1 ويسال عنها خبراء المحاسبة و الحسابات <<---< عارف واحد بيقول انت على الله حكايتك ومصدعنا تفعيل نوع العملة ( مؤنثة ) لاستخدامها في التطبيقات عدد الخانات العشرية المستخدمة في العملة فبعض العملات تتكون اجزائها من ثلاث منازل عشرية وليس اثنان فقط كما هو الشائع اسم كسر العملة بصيغة المفرد اسم كسر العملة بصيغة المثنى اسم كسر العملة بصيغة الجمع اسم كسر العملة بصيغة حالة النصب القيمة الأساسية لكسر العملة ونفس البيانات مرة أخرى للغة الانجليزية ان اردت اللغتان معا او اى لغة اخرى غير الانجليزية جيب الرغبة واخيرا رمز ISO المخصص للعملة : كود العملة او رمز اختصار العملة المتعارف عليه عالميا لا علاقة له بالاكواد نهائيا ولكن وضعتخ لمن يريد اضافته او استخدامه فى تطبيقه تبعا لكل عملة حاسس حد و كمان سامع حد بيقول منا مش فاهم الهيلوغريفى المكتوب ده ويقصد الـ Ascii مثل ( Chr(218) & Chr(230) & Chr(207) ) وهنا تأتى دور الاداة الجبارة و المساعدة فى التحويل الى او من الـ Ascii واحد تانى هناك اهو عمال يقول ايه الصداع ده ووجع النفوخ ده بص يا سيدى انا قلت نبذة عن الاكواد والافكار لمن يريد العلم والتعمق او التعديل عليها اذا اين الزتونة فين من غير وجع راس كتير فهذا ما يشغل الـ End User نسخ الوحدة النمطية ونقلها كما هى الى فاعدة بياناتك للمرة الاول فقط استدعى الوظيفة بالشكل التالى للغة العربية الوضع الافتراضى : ConvertNumberToWords([CurrencyValue]) وطبعا لا تنسيى تغير CurrencyValue باسم الحقل لو يتم الاستدعاء من خلال استعلام او مربع النص لو من نموذج الكود شاطر ذكى وابن حلال من نفسه ينشئ جدول جديد باسم : tblCurrencyInfo ولان انا تعبت بصراحة مكنتش قادر اكمل عملات تانى فى الكود اكثر من تلك الموجودة بالجدول بعد انشائه 9 انواع من العملات تقريبا الان يمكنك اضافة العملات التى تريد التعامل معها فى الجدول بنفس الطريقة يدويا من الحقول مباشرة بعيد عن الاكواد وعلى نفس سيناريو الاسماء المستخدمه لاى عملة المفرد والمثنى والجمع وووو... الخ الان كل ما عليك هو : اختيار نوع عملة واحد فقط من الجدول بتنشيط العملة باستخدام القيمة البولينيه True على ان لا يتم اختيار أكثر من عملة فى آن واحد ستجد ان العملة الافتراضية عند انشاء الجدول هى : ريال سعودي طيب سامعك يا اللى بتقول طب لو عاوز اغير العملة الافتراضية من الكود بحيث تكون هى المؤشر عليها من الكود عند انشاء الجدول للمرة الاولى فقط فى اول الوحدة النمطية تجد الوظيفة الاتية : CurrencyYouWantToBeActive Public Function CurrencyYouWantToBeActive() CurrencyYouWantToBeActive = Chr(209) & Chr(237) & Chr(199) & Chr(225) & Chr(32) & Chr(211) & Chr(218) & Chr(230) & Chr(207) & Chr(237) End Function و تشفير الـ Ascii هذا ترجمته : ريال سعودي اه والله زيمبئولك كده كل كا عليك هو تغيير اسم العملة فى الكود بالاسم المستخدم كبيانات للحقل CurrencyNameSingular طيب لو فتحنا الاستعلام سوف نجد ان التفقيط العربي و الانجليزي مكرر ما السبب السبب فى ذلك هو اولا وبفضل الله تعالى ثم المستشار الامين الاستاذ @Moosak بارك الله فيه عندما كنت اطلب منه التجربة للوقوف على مشاكل الكود البرمجية التى قد تواجه المستخدمين كنت قد اعتمدت فى البداية على ان تكون الارقام من سلسلة نصية بناء عليه الحقل سوف يكون نصى وكان ردة هو الاتى هههههههه اقول له طيب لو مستعجل عدلها انا تعبت خلاص يرد و يقول لى هههههههههههه لذلك تم بفضل الله تعديل الوظيفة فأصبحت وبكل مرونة تتعامل مع كلا النوعين من الحقول النوع النصى والنوع الرقمى والان ايها المستشار المؤتمن جه الوقت لنقول عبى ياا باااااااااااااا إنتهى الموضوع ------------------------------------------------------------------ ان شاء الله تم الانتهاء من التحديث الاخيــــر - تم تحديث الموضوع والمرفقات بتاريخ 18/08/2024 اسباب التحديث : اولا تم زيادة الاعداد التى يقبلها الكود للتعامل مع الرقم الطبيعى مثل 100000000000000000000000000000000000000000000000000000000000000000000000 والرقم العلمى والذى يستخدمه الاكسس فى حقل الارقام لنفس الرقم السابق 1E+71 وتم ضبط الكود فى حالة كان الحقل نصى لكى يتعامل مع الشكلان إما الشكل الطبيعى أو الشكل العلمى ثانيا الكود الان يقوم بعمل تفقيط للعملات او للاعداد بدون عملات وذلك ليكون الكود اكثر مرونه " وده كان رأى الاستاذ موسي " وتم تفقيط الاعداد كما هى تمام سواء بالسالب او الموجب دون الاهذ فى الاعتبار للاصفار على يساء المنار العشرية دى لوحدها اختراع والله وعمرى ما شوفتها اصلا " وده كان رأى الاستاذ موسي " ثالثا الاكواد فى النموذج لتحميل اسماء العملات من جدول العملات الى مربع السرد وهى مجرد استدعاء من دالة فى الوحدة النمطية وذلك اذا اراد المستخدم تفقيط اكثر من عملة مختلفة النوع فى نفس النموذج بسهولة frmBulder رابعا بناء على طلب سيادة المستشار المؤتمن الاستاذ @Moosak تم تصيم نموذج مولد مود الاستدعاء للدوالة بكل أشكال وطرق الاستدعاء المختلفة وفى النهاية يبقى السيناريو الاصلى والاساسى كما كان تماما ولم يتغير أى شئ و يتم الاستدعاء بأشكال متعددة فقط لاضفاء مرونة أكبر كما اشرت فى الاكواد لطرق استدعاء الدالة باشكالها المختلفة فى رأس الموديول وكما هو موضح ايصا فى قاعدة التجربة المرفقة توضيح المرفقات : المرفق الاول : اداة تحويل النصوص من والى الـ Ascii : Text Converter Ascii (v. 3) المرفق الثانى : ملف الوحدة النمطية العامة فقط : basHandleNO2Words المرفق الثالث : قاعدة البيانات الخاصة بالتفقيط :HandleNumber2Words هى قاعدة بيانات تحتوى على موديول اكواد التفقيط للتجربة وتوضيح اشكال الاستدعاء المختلفة Text Converter Ascii (v. 3).accdb basHandleNO2Words.zip HandleNumber2Words V2.0.1- Test.zip

السلام عليكم ورحمة الله وبركاته اخواني والاساتذة الكرام لكم مني كل الاحترام والتقدير للجهود والمعلومات القيمة التي تقدمونها لنا بهذا التخصص والذي اصبحت معلومات جيده من دروسكم ومساعداتكم لنا شكرا لكم ولتواضعكم جميعا اخوتي لدي مشكلة في موضوع التفقيط وهي ان التفقيط لا ينحصر مع العدد الصحيح وانما يقوم بتفقيط العدد الكسري هل هناك طريقة للتفقيط فقط للعدد الصحيح فمثلا 150.320 مائة وخمسون دينار و 320 فلس لاغير ولكم جزيل الشكر

ليس هناك مستحيل اخي @عبد الرحمن أشرف يمكننا إظافة دالة جديدة مع الحفاظ على الأولى لتتمكن من إختيار ما يناسبك الدالة الجديدة مع التفقيط Option Explicit Function CalcAgeArabic(vDate1 As Variant, vDate2 As Variant, ByVal resultType As String) As Variant Dim vYears As Integer, vMonths As Integer, vDays As Integer If IsEmpty(vDate1) Or IsEmpty(vDate2) Then CalcAgeArabic = "" Exit Function End If If Not IsDate(vDate1) Or Not IsDate(vDate2) Then CalcAgeArabic = CVErr(xlErrValue) Exit Function End If If vDate2 < vDate1 Then MsgBox "التاريخ الثاني يجب أن يكون أكبر من الأول" CalcAgeArabic = CVErr(xlErrValue) Exit Function End If vYears = Year(vDate2) - Year(vDate1) vMonths = Month(vDate2) - Month(vDate1) vDays = Day(vDate2) - Day(vDate1) If vDays < 0 Then vMonths = vMonths - 1 Dim lastMonth As Date lastMonth = DateAdd("m", -1, vDate2) vDays = Day(DateSerial(Year(lastMonth), Month(lastMonth) + 1, 1) - 1) + vDays End If If vMonths < 0 Then vYears = vYears - 1 vMonths = vMonths + 12 End If Select Case resultType Case "Days" CalcAgeArabic = NumberToArabicWords(vDays) & " يوم" Case "Months" CalcAgeArabic = NumberToArabicWords(vMonths) & " شهور" Case "Years" CalcAgeArabic = NumberToArabicWords(vYears) & " سنوات" Case "Days and Months" CalcAgeArabic = NumberToArabicWords(vMonths) & " شهور و " & NumberToArabicWords(vDays) & " يوم" Case "Years and Months" CalcAgeArabic = NumberToArabicWords(vYears) & " سنوات و " & NumberToArabicWords(vMonths) & " شهور" Case "Years, Months, Days" CalcAgeArabic = NumberToArabicWords(vYears) & " سنوات و " & NumberToArabicWords(vMonths) & " شهور و " & _ NumberToArabicWords(vDays) & " يوم" Case Else CalcAgeArabic = "صيغة الدالة غير معروفة" End Select End Function Function NumberToArabicWords(ByVal Number As Integer) As String Select Case Number Case 1: NumberToArabicWords = "واحد" Case 2: NumberToArabicWords = "اثنان" Case 3: NumberToArabicWords = "ثلاثة" Case 4: NumberToArabicWords = "أربعة" Case 5: NumberToArabicWords = "خمسة" Case 6: NumberToArabicWords = "ستة" Case 7: NumberToArabicWords = "سبعة" Case 8: NumberToArabicWords = "ثمانية" Case 9: NumberToArabicWords = "تسعة" Case 10: NumberToArabicWords = "عشرة" Case 11: NumberToArabicWords = "أحد عشر" Case 12: NumberToArabicWords = "اثنا عشر" Case 13: NumberToArabicWords = "ثلاثة عشر" Case 14: NumberToArabicWords = "أربعة عشر" Case 15: NumberToArabicWords = "خمسة عشر" Case 16: NumberToArabicWords = "ستة عشر" Case 17: NumberToArabicWords = "سبعة عشر" Case 18: NumberToArabicWords = "ثمانية عشر" Case 19: NumberToArabicWords = "تسعة عشر" Case 20: NumberToArabicWords = "عشرون" Case 21: NumberToArabicWords = "واحد وعشرون" Case 22: NumberToArabicWords = "اثنان وعشرون" Case 23: NumberToArabicWords = "ثلاثة وعشرون" Case 24: NumberToArabicWords = "أربعة وعشرون" Case 25: NumberToArabicWords = "خمسة وعشرون" Case 26: NumberToArabicWords = "ستة وعشرون" Case 27: NumberToArabicWords = "سبعة وعشرون" Case 28: NumberToArabicWords = "ثمانية وعشرون" Case 29: NumberToArabicWords = "تسعة وعشرون" Case 30: NumberToArabicWords = "ثلاثون" Case Else: NumberToArabicWords = CStr(Number) End Select End Function حساب الفرق بين تاريخين - بالتفقيط (1).xlsm

عند محاولة كتابة الدالة arbnum2text فإنها لاتظهر في الاكسس يرجى المساعدة في طريقة اظهارها ولكم جزيل الشكر

بسم الله الرحمن الرحيم تطرق الكثير من المبرمجين إلى موضوع التفقيط وهو تحويل الأرقام إلى كلمات عربية ولكني كمعلم لمادة اللغة العربية لم أجد من هذه الدوال ما يتوافق مع قواعد اللغة العربية قاعدة كتابة الأعداد العربية بطريقة مضبوطة وصحيحة وتجد في هذا الرابط شرح مبسط للعدد وتمييزه http://www.reefnet.g.../AdadMadoud.htm وبفضل الله قمت ببرمجة دالة تقوم بتحويل الرقم إلى كلمات عربية مضبوطة تماماً وموافقة لجميع قواعد كتابة العدد في اللغة العربية تجدها هنا https://officena.net/team/mas/tafkeet وتم برمجة هذه الصفحة بلغة php وهذا الإصدار الجديد يعتمد فقط علي جافاسكريبت https://www.mr-mas.com/p/tafqeet.html وإذا لاقى الموضوع قبولا وإعجابا فسوف أعرض عليكم الكود الخاص بهذه الدالة أخوكم محمد صالح مبرمج بأكثر من لغة برمجة ومصمم ومطور مواقع

تجربة بالعافية 😡 ورخامة اعتذر لحضرتك يا دكتور @الحلبي 🤣 استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل انا فمت بتعديل المرفق الخاص بهذا الموضوع باضافة الوحدة النمطية النهائية بعد التعديلات الاخيرة بتاعة الخبراء اللى بتلعب من ورايا 🤣 بعد فتح المرفق سوف تلاحظون الاتى 1- عدم وجود جدول tblCurrencyInfo 2-وجود الوحدة النمطية الجديدة باسم basCurrencyNumbersTotext 3- عند فتح النموذج f1 فى وضع التصميم تم اضافة مربع نص واستخدام الكود الاتى فى مصدر بيانات مربع النص =ConvertNumberToWords([vol]) 4- عند فتح النموذج f1 فى الوضع الطبيعى تلاحظون انه تمت اضافة إجراءات التفقيط بإضافة جدول العملات تلقائيا وتمت عملية التفقيط بنجاح النسبة المئوية4.zip

طباعه الشيكات.rar

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

طيب وبما انك اعجبت بالافكار وسوف تضع فى اعتبارك تم تحديث موضوع التفقيط المرفق الاخير الان تقريبا شبه كامل ان شاء الله الا ان اللهم الاستاذ @Moosak الله يبارك له صاحب المكتبة العامرة والمستشار المؤتمن كما يحب ان بلقب نفسه يريد اضافة دوال لتفقيط التاريخ ايضا اوماااال لازم يتعبنى جارى اعداد هذه الحزئية

طيب مبدئيا كده : الاكواد والدوال هى هى فقط تمت بعض التعديلات الطفيفة جدا جدا جدا قمت باعادة تسمية الدوال للتناسب مع الوظائق الجديدة التى تم اضافتها الوظائف الجديدة فقط تقرأ الارقام بعد العلامة العشرية بمعالجة خاصة بسبب تواجد الرقم صفر بعد العلامة العشرية مباشرة تم اضافة نموذج منشئ الكود للدوال اترككم للتجربة والاستمتماع ان شاء الله بأمر الله تعالى تقريبا انتهى هذا الموضوع نهائيا بإقتراب الافكار والمرفق الى اقرب درجات الكمال . 1- التعامل بشكل صحيح مع عدد المنازل العشرية لكسر العملات المختلفة وامكانية تعديل المنازل لكل عملة من الجدول 2- ضبط صيغ المسميات لكسر العملات تبعا للجنس من خلال المسميات الذكورية و الانثوية وامكانية تعديل الجنس لكل عملة من الجدول 3- ضبط الالفاظ اللغوية تقريبا بالشكل الصحيح أو بأقرب شكل ممكن 4- التحكم فى نوع العملة الافتراضية التى يتم التفقيط لها من الجدول باختيار تنشيط عملة واحدة 5- امكانية التعامل مع اكثر من عمل فى نفس الوقت بأكبر قدر ممكن من المرونة 6- امكانية التعامل مع لغة اخرى غير اللغة العربية بالنسبة لكل الاخطاء يا اللى كانت بالكود بحمد الله تعالى وبفضله تم التأكد من التعامل معها بشكل احترافى تم تحديث المرفقات فى رأس الموضوع بالمشكاركة الاولى ويمكن تحميل المرفقات من هنا او من هناك basHandleNO2Words.zip HandleNumber2Words V2.0.1- Test.zip Text Converter Ascii (v. 3).accdb

محتاج معادلة تفقيط في الخانة Cheque print.xlsm

بسم الله ، ما شاء الله ، الله أكبر ، الله أكبر .. عيني عليك باردة يا معلم سؤال لولبي قد يخطر في ذهن الآخرين ، كيف يمكن استدعاء التفقيط في مربع نص داخل نموذج بعد ما قدرت أوصل للجزئية دي ن كنت محتاج أتعلم لغات هذه محاولتي المتواضعة في تعديل بسيط على هذه الدالة للتعرف على القيم السالبة كما طرحها الأستاذ @Moosak، وطبعاً ده بعد إذن البشمهندس @ابو جودي Function ConvertNumberToWords(number As Variant, Optional language As String = "ar") As String If Nz(number, "") = "" Or Len(number) = 0 Or number = Empty Then ConvertNumberToWords = "" Exit Function ElseIf IsNumeric(number) And number = 0 Then If language = "ar" Then ConvertNumberToWords = Chr(213) & Chr(221) & Chr(209) Else ConvertNumberToWords = "Zero" End If Exit Function ElseIf Not IsNumeric(number) Then If language = "ar" Then ConvertNumberToWords = Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(219) & Chr(237) & Chr(209) & Chr(32) & Chr(213) & Chr(199) & Chr(225) & Chr(205) & Chr(201) ' "قيمة غير صالحة" Else ConvertNumberToWords = "Invalid value" End If Exit Function End If Dim isNegative As Boolean isNegative = (number < 0) If isNegative Then number = Abs(number) End If Dim CurrencyUnits As Variant Dim CurrencySubUnits As Variant Dim PrefixText As String Dim SuffixText As String Dim currencyValues As Variant Dim NumberOfDecimalPlaces As Integer Dim isCurrencyFeminine As Boolean currencyValues = GetCurrencyValues(language) NumberOfDecimalPlaces = IIf(IsNumeric(currencyValues(11)), currencyValues(11), 2) isCurrencyFeminine = currencyValues(12) If language = "ar" Then CurrencyUnits = Array(currencyValues(0), currencyValues(1), currencyValues(2), currencyValues(3), currencyValues(4)) CurrencySubUnits = Array(currencyValues(5), currencyValues(6), currencyValues(7), currencyValues(8), isCurrencyFeminine) PrefixText = Chr(221) & Chr(222) & Chr(216) SuffixText = Chr(225) & Chr(199) & Chr(32) & Chr(219) & Chr(237) & Chr(209) Else CurrencyUnits = Array(currencyValues(0), currencyValues(1), currencyValues(2), currencyValues(3), currencyValues(4)) CurrencySubUnits = Array(currencyValues(5), currencyValues(6), currencyValues(7), currencyValues(8), currencyValues(9), isCurrencyFeminine) PrefixText = "Only" SuffixText = "No more" End If Dim fullNumber As Variant Dim integerPart As String Dim fractionalPart As String Dim integerWords As String Dim fractionalWords As String If IsNumeric(number) And number > 0 Then fullNumber = Split(IIf(InStr(number, ".") > 0, number, number & ".0"), ".") integerPart = IIf(Len(fullNumber(0)) > 21, Right(fullNumber(0), 21), fullNumber(0)) fractionalPart = Mid(fullNumber(1) & String(20, "0"), 1, NumberOfDecimalPlaces) integerWords = ConvertToWords(integerPart, CurrencyUnits, language) fractionalWords = ConvertToWords(fractionalPart, CurrencySubUnits, language) Dim ResultConvert As String ResultConvert = PrefixText & " " & integerWords & IIf(Len(integerWords) > 0 And Len(fractionalWords) > 0, IIf(language = "ar", Chr(32) & Chr(230), " and "), "") & fractionalWords & " " & SuffixText ResultConvert = Trim(Replace(ResultConvert, " ", " ")) If ResultConvert = Chr(221) & Chr(222) & Chr(216) & " " & Chr(225) & Chr(199) & Chr(32) & Chr(219) & Chr(237) & Chr(209) Then ResultConvert = "" If ResultConvert = "Only" & Space(1) & "No more" Then ResultConvert = "" If isNegative And language = "ar" Then ResultConvert = Chr(32) & Chr(211) & Chr(199) & Chr(225) & Chr(200) & " " & ResultConvert ElseIf isNegative And language <> "ar" Then ResultConvert = "Negative " & ResultConvert End If ConvertNumberToWords = ResultConvert Else ConvertNumberToWords = Chr(222) & Chr(237) & Chr(227) & Chr(201) & Chr(32) & Chr(219) & Chr(237) & Chr(209) & Chr(32) & Chr(213) & Chr(199) & Chr(225) & Chr(205) & Chr(201) End If End Function Convert currency numbers to words v 6.accdb

الله الله على العظمة ، والجمال ، والإبداع ، والتميز ، والشمولية ، والطفرة الجينية اللامتناهية في الروعة بصراحة لله درك يا عبقري .. ياجنون الإبداع 🖐🏻️ بسم الله .. ما شاء الله .. ما شاء الله .. صلاة النبي عليك .. الواحد يقف إجلالا واحتراما لك وتقديرا على هذي الهبة الربانية ☺️✋🏻 شكرا لك على هذي التحفة الجميلة الرائعة ، وأجمل قطعة فنية تحل ضيفة عزيزة على مكتبتنا العامرة .. 😇🌹 -------------------------------------------------------------------------- والحقيقة أن الأفكار في هذا الموضوع كثيرة ولا تنتهي 😅🖐🏻️ ومنها : 1 - عندنا جدول tblCurrencyInfo مليء بالعملات ، فممكن نستفيد من هذا الموضوع ونخلي الدالة تقرأ أكثر من عملة في نفس النموذج مثلا ، وذلك بإضافتها كمتغير للوظيفة ConvertNumberToWords لأن في بعض البلدان يتم التعامل مع أكثر من عملة في نفس الوقت . 2 - أحيانا نحتاج لتحويل الأرقام لحروف لغير العملات كمثال ( للعمر - للتواريخ - رقم المراجع في طابور الانتظار - رقم الصفحة - ......... الخ ) فممكن نعمل دالة إضافية Function لتحويل الأرقام بدون التفقيط واسماء العملات . -------------------------------------------------------------------------- لا تزال هناك ملاحظات الهدف منها التحسين والتطوير ، مش عشان نزهقك 😂🖐🏻️: 1 - القيم السالبة لايتم تفقيطها ! ، والمفروض أن يكتب أمامها كلمة " سالب .... كذا وكذا " وهي مهمة جدا في الحسابات المالية . 2- الصفر في الحقول الرقمية لا ترجع الدالة بكلمة "صفر" بل تعود فارغة . -------------------------------------------------------------------------- إحنا بصراحة شفقانين عليك من التعب يا حبيب الملايين @ابو جودي ، بس طمعانين في خبراتك والحلاوة الجاهزة ومن ناحية ثانية ( خايفين نبوظ التحفة الجميلة هذي ) 😂👌 كفاية عليه ساعتين وأنا بقرأ الأكواد علشان أفهمها بس 😂 -------------------------------------------------------------------------- وأخيرا وليس آخرا : أسأل الله العظيم أن يرضى عنك وعن والديك وأن يسكنك معهما ومن تحب في أعالي الجنان 🤲🏻😊🌷🌹

انت بتقلب فى المنتدى يا فؤش وتطلع المرفقات القديمة... عاااااش انتظروا قريبا جدا بأمر الله كدت انتهى من تحضير هدية قيمة بمعنى الكلمة إن شاء سوف تكون طفرة بمعنى الكلمة فى موضوع التفقيط وحصريا فى منتدانا الحبيب لن تجدوا لها مثيل الا فى المكتبة العامرة 😄 لانه وصل بالسلامة للمكتبة

اخي الكريم هذا ملف جاهز سبق ان وضعه احد الاخوان في المنتدى فجزاه الله عنا خيرا وضعت لك فيه شيت خاص بمطلوبك ملف دالة التفقيط.xlsm

يا عم حرام عليك انت عامل ايه انت كل ما تلاقى موضوع بيتكلم عن التفقيط او تحويل الارقام لـ تيكست تضيف اكواده وخلاص ؟؟؟

اولا السلام عليكم استاذي الغالي نعم انا عاوز التفقيط يكون بالشكل التالي 150.320 مائة وخمسون دينارا و 320 فلسا لا غير

السلام عليكم هل يوجد كود للتفقيط في الاكسل لرقم يحوي ثلاثة مراتب عشرية مثال ٧٨،٣٤٥

السادة / أعضاء المنتدى الكرام السلام عليكم و رحمه الله و بركاتة مرفق شيت يحتوى على سندات صرف و قبض و لكن للاسف التفقيط لايعمل تلقائيا برجاء المساعدة جزاكم الله خيرا خزينة القاهرة.xls

تفضل اخي تم استبدال الكود ليتناسب مع متطلباتك الحالية مع دمج الاكواد السابقة في نفس الملف Sub CopyData2() Dim x&, OneRng As Range, rCrit As String Dim srcWS As Worksheet, WS As Worksheet Dim i As Long, lrow As Long Set srcWS = Sheets("Data") Set WS = Sheets("FORM3"): rCrit = WS.[G2].Value 'قم بتعديل كود التفقيط بما يناسبك Const iCnt As String = "=IFERROR(@NombreToArabe(E9),"""")" If IsEmpty(WS.[G2].Value) Then: Exit Sub Set OneRng = srcWS.Columns(3).Find(What:=rCrit, LookIn:=xlValues, LookAt:=xlWhole) If OneRng Is Nothing Then MsgBox rCrit & " : " & "غير موجودة", vbInformation: Exit Sub Else Application.ScreenUpdating = False lrow = WS.Cells(WS.Rows.Count, "C").End(xlUp).Row For i = 11 To lrow Union(WS.Range("C" & i), WS.Range("E" & i)).ClearContents Next i x = OneRng.Row WS.[A9] = srcWS.Cells(x, 1) 'الرقم WS.[B9] = srcWS.Cells(x, 2) 'رقم صفحة WS.[C9] = srcWS.Cells(x, 3) 'نوع اللوازم و مواصفاتها WS.[D9] = srcWS.Cells(x, 4) 'رصيد السجل WS.[E9] = srcWS.Cells(x, 33) 'المجموع With WS.[F9] 'العدد كتابة .Formula = [iCnt]: .Value = .Value End With tmp = srcWS.Range("A4:AF" & srcWS.Cells(Rows.Count, 3).End(xlUp).Row).Value2 Dim a(): ReDim a(1 To UBound(tmp) * UBound(tmp, 2), 1 To 5) n = 0 For ligne = 1 To UBound(tmp, 1) For Col = 6 To UBound(tmp, 2) If tmp(ligne, 3) = rCrit And tmp(ligne, Col) <> "" Then n = n + 1 a(n, 2) = tmp(1, Col) 'رؤوس الاعمدة a(n, 4) = tmp(ligne, Col) ' رصيد الغرف المتوفرة End If Next Col Next ligne WS.Cells(k + 11, 2).Resize(n, 3 + 1) = a IRow = WS.Cells(Rows.Count, "E").End(xlUp).Row + 1 WS.[F11] = Application.Sum(WS.Range("E11:E" & IRow)) ' مجموع عمود الرصيد End If Application.ScreenUpdating = True End Sub لقد لاحظت انك لديك القدرة لفهم الاكواد من خلال التعديلات التي قمت بها على الاقتراحات السابقة . حاولت توضيح بعض النقط المهمة على الكود ليسهل عليك التعديل على حسب احتياجاتك مستقبلا. بالتوفيق ..... DATA V4.xlsb

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

فعلا المطلوب بالظبط بس ممكن ابعت لحضرتك الملف الاصل تعمل التفقيط لانه انا معرفتش اعمله كتر خيرك والله حضرتك خير صديق الجمعية التعاونية.rar

السلام عليكم بحتث في الانترنت لاجد هذا الكود حاولت كثيرا جاهدا لتعديل الكود بناء على العملة التي في بلدي ولكن للاسف تنسيق الكلمات غير دقيق في التيكست بوكس2 عند اظهار الرقم في التيكست بوكس 1 يجب اظهار المبلغ بالاحرف في التيكست بوكس2 لذا فضلا وليس امرا اذا كان في امكانية لتنسيق الارقام . تحياتي تفقيط باليوزرفورم.xlsm

تحية طيبة وبعد عندي مشكلة بمعادلة التفقيط حيث انها تعمل بشكل صحيح من جهازي ولكن من جهاز صديقي لاتعمل وتعطيني النتيجة المرفقة بالصورة ارجو التكرم بحل هذه المشكلة ولكم خالص التحية والتقدير

الزملاء الافاضل ممكن حد يفيدنى لما بكتب كود دالة التفقيط (Nototxt) اى كلام عربى فى الكود بيكون فيه مشكلة وبيظهر بالشكل ده