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

السلام عليكم ورحمة الله تعالى وبركاته الموضوع اخذ وقت وجهد شديدين ان شاء الله ينال رضاكم واقدمه ابتغاء وجه الله تعالى ليكون هدية قمية فى مكتباتكم وقواعد بياناتكم فى اعمالكم ان شاء الله اولا وبادئ ذى بدئ لابد أن أتقدم باخالص الشكر والتقدير والعرفان بالجميل لمن تحملوا إثقالى عليهم مرارا وتكرار دون كلل أو ملل حتى يخرج هذا العمل فى أبهى صورة وبهذا الشكل معلمى القدير وأستاذى الجليل و والدى الحبيب الأستاذ @ابوخليل أول يد امتدت إلى فى هذا الصرح الشامخ فتحمل جهلى دائما بحلم ودوما يصحح لى أخطائى بعلم فجزاه الله تعالى عنى وعن كل طلاب العلم كل الخير وحتى لا أضيع فضل أحد الأساتذة العظماء أو ينسينى الشيطان ذكر ـى من العظماء الكرام الذين نتعلم منهم جمبعا فى هذا الصرح الشامخ الذى هو بمثابة ينابيع العلوم والمعرفة وبساتين الأفكار التى نطوف بهم فنرتشف من كل ينبوع قطرة ونأخذ من كل بستان زهرة جزا الله كل أصحاب الفضل علينا والذين نتعلم على اياديهم المباركة وشكر الله لكم حسن صنيعكم معنا و تحملكم لنا . صاحب المكتبة العامرة سيادة المستشار المؤتمن ... والله اشتقنا الاستاذ @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

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

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

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير اطلب المسامحة ممن راسلني ولم يجد رد مني هديتي لكم بعد هذه الغيبة Option Explicit '========================================================" ' بسم الله الرحمن الرحيم " '========================================================" ' (دالة تحويل الرقم الى نص باللغة العربية (تفقيط " ' kh_TextNum " '========================================================" 'Num الرقم " '========================================================" 'sex جنس العملة " 'FALSE ( فارغ او صفر مذكر ) " 'TRUE ( أو اي رقم غير الصفر مؤنث ) " '========================================================" 'sNameCurr اسم العملة الرئيسية مفرد " 'pNameCurr اسم العملة الرئيسية جمع " 'NameCurrDec اسم العملة الكسرية " 'Decimal_Count طول الكسر افتراضـياً : بدون اظهار الكسر " '===============================================================================================================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" ' ملاحظات ' (اولاً : العملة الرئيسية مثنى (يقوم بها الكود تلقائيا ' مع ملاحظة اذا اسم العملة ينتهي بالتاء المربوطة ' يجب ان يكتب كذلك وليس بالهاء ' ----------------------- ' ثانياً : اذا كانت العملة الرئيسية مفرد فارغاً تعتبر ' اسماء العملات (الجمع والكسري) فارغة تلقائيا ' ----------------------- 'ثالثاً : الكلمة الابتدائية بامكانك تغييرها او تجعلها فارغة Private Const MyBegTx As String = "فقط " ' "" ' ----------------------- ' MyTNum رابعا : يمكنك التغيير (اضافة,حذف,تحرير) في الثابت ' للفئات الصفرية للرقم ادناه Private Const MyTNum As String = "ألف-آلاف/مليون-ملايين/مليار-مليارات/بليون-بلايين/بليار-بليارات/ترليون-ترليونات/تريليار-تريليارات/كدرليون-كدرليونات" '===============================================================================================================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" Function kh_TextNum(Num As String, Optional sex As Boolean = False, Optional sNameCurr As String = "", Optional pNameCurr As String = "", Optional NameCurrDec As String = "", Optional Decimal_Count As Byte = 2) As String Dim Spp, zt Dim i%, ii%, pr% Dim MyMid$, nCurr$, Txt$, Txt1$, Txt2$ '====================================== If Not IsNumeric(Num) Then GoTo kh_Exit Spp = Split("/" & MyTNum, "/") ii = UBound(Spp) If Num < 0 Then Num = Abs(Num) '====================================== If Val(Num) > Val(String((ii + 1) * 3, "9") & ".999") Then GoTo kh_Exit '====================================== nCurr = sNameCurr & "-" & IIf(pNameCurr = "", sNameCurr, IIf(sNameCurr = "", "", pNameCurr)) '====================================== Txt1 = Format(Num, String((ii + 1) * 3, "0") & ".000") For i = 0 To ii MyMid = Mid(Txt1, (i * 3) + 1, 3) If MyMid Then zt = Mid(Txt1, (i * 3) + 4, Len(Txt1)) zt = IIf(ii - i, Int(zt), zt) Txt2 = IIf(ii - i, Trim(Spp(ii - i)), nCurr) pr = 1 + IIf(ii - i, 1, CInt(sex)) Txt = Txt & IIf(Len(Txt), " و", "") & kh_nText(MyMid, Txt2, pr, zt, CBool(sNameCurr <> "")) End If If i = ii Then If MyMid = 0 Then Txt = Txt & IIf(Len(Txt), " ", "صفر ") & sNameCurr Next '====================================== Txt = MyBegTx & Txt & kh_dText(Num, sNameCurr, NameCurrDec, Decimal_Count) '====================================== kh_Exit: kh_TextNum = Trim(Txt) End Function ' معالجة العدد من 1 الى 999 لكل فئات الرقم Private Function kh_nText(ByVal iNum As String, ByVal oMm As String, ByVal ibs As Integer, ByVal z As Boolean, ByVal tCu As Boolean) As String Dim Sp Dim Num1%, Num2%, Num3% Dim oM$, S$, S1$, nT$, nT0$, nT1$, nT2$ '====================================== Sp = Split("واحد,إحدى,اثنتان,ثلاث,أربع,خمس,ست,سبع,ثمان,تسع,عشر,إحدى ,اثنتا ", ",") '====================================== If ibs Then S = "ة": Sp(1) = Sp(0): Sp(2) = "اثنان": Sp(11) = "أحد ": Sp(12) = "اثنا " Else S1 = "ة" oM = Trim(Split(oMm, "-")(0)) '====================================== Num1 = Left(iNum, 1) Num2 = Right(iNum, 2) Select Case Num1 Case 1: nT0 = "مائة" Case 2: nT0 = "مائتا" & IIf(ibs = 2, IIf(Num2 < 3, "", "ن"), IIf(Num2 = 0 And oM <> "", "", "ن")) Case 3 To 9: nT0 = Sp(Num1) & "مائة" End Select '========================================= Num1 = Right(iNum, 2) Select Case Num1 Case 1, 2: If nT0 <> "" Then If ibs = 2 Then nT0 = nT0 & " " & oM Case 11 To 99: If oM <> "" Then If ibs Then If z Then oM = oM & "اً" End Select '----------------------------------------- Select Case Num1 Case 1 nT = IIf(oM = "", Sp(0) & S1, oM) oM = IIf(ibs <> 2 And oM <> "", Sp(0) & S1, "") Case 2 nT = IIf(oM = "", Sp(Num1), Replace(oM, "ة", "ت") & IIf(z = 0 And ibs = 2 And tCu, "ا", "ان")) oM = IIf(ibs <> 2 And oM <> "", Sp(Num1), "") Case 3 To 10 oM = Trim(Split(oMm, "-")(1)) nT = Sp(Num1) & S Case 11, 12 nT = Sp(Num1) & Sp(10) & S1 Case 13 To 19 nT = Sp(Num1 - 10) & S & " " & Sp(10) & S1 Case 20 To 99 Num2 = Right(Num1, 1) Num3 = Left(Num1, 1) If Num3 = 2 Then nT1 = "عشرون" Else nT1 = Sp(Num3) & "ون" nT2 = Sp(Num2) & IIf(Num2 > 2, S, "") & " و" & nT1 If Num2 = 0 Then nT2 = nT1 nT = nT2 End Select '====================================== S = IIf(nT = "" Or iNum < 100, "", " و") nT = Replace(nT, Sp(8) & "ة", Sp(8) & "ية") kh_nText = Trim(nT0 & S & nT & " " & oM) '====================================== End Function ' معالجة الكسر Private Function kh_dText(ByVal dNum As String, ByVal NCur As String, ByVal Ndec As String, ByVal co As Byte) As String Dim Td$, Td1$ On Error GoTo 1 If NCur = "" Then Ndec = "" Td = Format(Round(CCur(dNum - Int(dNum)), co), "0." & String(co, "0")) If Td = 0 Or Td = 1 Then Td1 = "": GoTo 1 If Len(Ndec) Then Ndec = " " & Ndec: Td1 = Td * CVar("1" & String(co, "0")) Else Ndec = " " & NCur: Td1 = Td Td1 = " و " & Chr(40) & Td1 & Chr(41) & Ndec 1: kh_dText = Td1 End Function دالة تحويل الرقم الى نص عربي.rar ================================================= الملف المعدل: هذا المرفق بامكانية تفقيط الكسر وامكانية ادخال كلمة نهاية النص دالة تحويل الرقم الى نص عربي.rar ================================================= رابط مباشر للملف

التفقيط وتحويل الارقام إلى حروف بالعربية في اكسل أخواني الأعزاء اقدم لكم ملف اكسل يحتوي على ماكرو تفقيط الارقام باللغة العربية https://youtu.be/yzDZmVH8WuM

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

السلام عليكم اخواني اريد تفقيط الارقام ولكن باللغة التركية بحثت بالنت ووجدت هذه المعادلة ولكن لا تظهر القروش وعند كتاية الرقم مع الفروش لا يظهر الكتابة ارجو المساعدة try.xlsm

بسم الله الرحمن الرحيم كيف الحال أحبابي في الله إن شاء الله بخير وسعادة ورضا كل عام أنتم جميعا بخير نلتقي من جديد في شهر ميلاد سيد الخلق وهديتي لكم بمناسبة المولد النبوي الشريف هي ********** بناء على طلب الأخ الفاضل @عبدالرحمن وسلمى قمت بعمل دالة معرفة لجلب ناتج التفقيط الموجود في صقحتي الشخصية فس موقع أوفيسنا https://officena.net/team/mas/tafkeet/ إلى ملف إكسل أو أكسس بشرط الاتصال بالانترنت ============== الجميل في الصفحة أنها تراعي بإذن الله كل قواعد صياغة العدد في اللغة العربية ولا تحتوي على أخطاء إملائية ولا نحوية وتمت برمجتها بلغة php لأني لم أجد من المرونة في لغة فيجوال بيسك للتطبيقات vba ما يسمح بنفس البرمجة المستخدمة في لغة الويب php لذا تم التحايل على الأمر بكود يقوم بطلب الصفحة الخاصة بالتفقيط وتمرير البيانات الخاصة بنا من صفحة الإكسل إلى الموقع ثم يسجل ما يعود به الموقع في الخلية ============ ويمكن الاستفادة من الكود في جلب بيانات أي صفحة من الانترنت عن طريقة vba والآن أترككم مع الملف التفقيط من الانترنت.rar

السلام عليكم تحية طيبة للادارة والاعضاء المحترمون احتاج الى دالة تقوم بتحويل الارقام الى كتابة مثلاً 65 تكتب خمس وستون

في كود التفقيط يعرض التاريخ 1/2/2012 يعطي الواحد اثنان الفان واثنى عشر والمطلوب لازم يعطي اليوم الاول من شهر شباط لعام الفان واثنى عشر ميلادي

بسم الله الرحمن الرحيم السلام عليكم ورحمه الله أحبتي الكرام رجاء هناك عدة مطالب 1- أعادة كتابة فترة زمنية معينة ولكن بدون العطلات 2- اعادة كتابة الاسماء بدون تكرار مع ذكر التاريخ 3- التفقيط إلي أيام وساعات وكل ده في مصنف واحد رجاء لا تردوا مصنفي صفر اليدين المصنف.rar

أخي الكريم المسألة بسيطة جداً فقط اتبع الخطوات ولا تهمل منها شيء 1-حمل الملفات المرفقة بالمقال والموضوعة بملف مضغوط وبعد فك الضغط ينتج لك الملفين التاليين Module1 و NewMacros 2-افتح وورد ومن قائمة أدوات اختر : ماكرو > محرر Visual Basic 3-من قائمة File اختر Import file ثم اختر الملفات التي قمت بتحميلها من المرفق 4-اغلق صفحة Visual Basic وارجع لصفحة وورد 5-من قائمة عرض اختر أشرطة أدوات > تخصيص ، ومن التبويب الأوامر وتحت قائمة فئات اختر وحدات ماكرو لتظهر فى القائمة المقابلة أمر Normal.NewMacros.تفقيط واضغط علية بالماوس مع السحب إلى شريط القوائم أو أي مجموعة من الأزرار 6-يمكنك تعديل الاسم والخواص بالضغط بالزر الأيمن على الأمر الجديد وذلك قبل غلق مربع حوار تخصيص 7-اكتب أي رقم مرغوب في وورد ثم حدده وهذه النقطة مهمة " التحديد" ثم اكبس الزر أز الأمر الذي أنتجته فيظهر التفقيط فوراً 8- لتغيير الليرة السورية والقرش افتح وورد ومن قائمة أدوات اختر : ماكرو > محرر Visual Basic ثم اتجه لمجموعة النورمال Normal > ومنها Modules ثم افتح المسمى New Macros فتجد نوع العملة قم بتغييرها من هنا نجاح العملية معك يعتبر نجاح لي ولك على السواء scorpion4ever المرفق Tafqeet.rar

بسم الله الرحمن الرحيم الحمد لله رب العالمين والصلاة والسلام علي سيدنا محمد النبي الامين وعلي من سار بهديه الي يوم الدين اما.....بعد في موضوع لي سابق طرحت كود تفقيط لتحويل الأرقام من أرقام إلى كتابة لكن (إنجليزي) http://www.officena.net/ib/index.php?showtopic=45828&hl= اليوم سأطرح لكم كود تفقيط أو ملف جاهز لإضافته في الفيجول بيسك بكل سهوله وإستخدامه كداله كاي داله أساسيه في الإكسيل طريقة إضافة ملف التفقيط : حمل ملف التفقيط من المرفقات وافتح ملف الإكسيل وإظغط على Alt+F11 وبعدها ستفتح لك صفحة الفيجول بيسك إذهب إلى File وبعدها Import File وضع الملف وأغلق الفيجول بيسك في الإكسيل إذهب الداله المعرفة من قبل المستخدم وستجدها NoToTxt وتابع الإدخالات كما في الصور المرفقة المميز في هذا التفقيط , يمكنك إضافة أي عمله مثل ريال"هلله_جنيه"قرش_دينار"فلس ملف تفقيط + إكسل شيت.rar

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة تم ارفاق كود الحل من الفاضل ا / أبوعبد الله مرفق الملف ENGLISH_FUNCTION.rar و لا تنسونا من صالح الدعاء تحياتى

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

تسلية بسيطة للتفقيط باستخدام المعادلات ولكم مني جزيل الشكر تجربة تفقيط.rar

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

لما اجي اعمل التفقيط عشان يفقط بالعربي بينقل في الdeveloper لغه غريبه مش مفهومه ومش عارف اظبط لغه الكمبيوتر عليه . انا عندي windows 8 وال office 2010 ارجوا المساعده

اسعد الله أوقاتكم، قمت بنسخ نص من احد المواقع وقمت بلصقه في برنامج Microsoft word 2010، الا ان الأرقام ظهرت باللغة الانكليزية (العربية لغة البرنامج) والمطلوب تحويلها الى اللغة العربية ( الهندية). علما بان إعدادات اللغة صحيحة في خيارات الوورد، الا ان المشكلة في أصل النص المنسوخ. هل بالإمكان انشاء كود لتحويل الأرقام من اللغة العربية الى اللغة الهندية: من 1,2,3,4,5,6 الى ١،٢،٣،٤،٥،٦ أرجو ان ألقى ضالتي لديكم خصوصا انني منذ فترة وانا ابحث ولم استطع. وشكرا لكم سلفا

اولا اشكر المنتدى الرائع جداااااااااااااااااااااااااااااااااااا على الموضوعات الرائعة جداااااااااااااا ارجو ان تكون داله تفقيط الانجليزى على سبيل المثال . Only sixty-four thousand five hundred sixty-four Pound & 55/100 ارجو ان تشمل الداله الكسر على شكل 55/100 وان تبداء بكلمة Only ............................................................................................. ارجو ان تكون داله تفقيط العربى على سبيل المثال فقط ألفاً ومائتان وإثنا عشر جنيه مصري و 100/55 لاغير . ارجو ان تشمل الداله الكسر على شكل 55/100 وان تنتهى بكلمة لاغير شكر لكم ...............

الاخوان الاعزاء الرجاء المساعدة بدالة تفقيط بالعربي لوحدة الدينار ولكم جزيل الشكر

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

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

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

السلام عليكم ورحمة اله وبركاته يرجى توضيح طريقة إدراج معادلة للتفقيط في ملف وورد بحيث يتم وضع الرقم وعند تنفيذ الكود يتم التفقيط تلقائياً له والكود مرفق في الملف المرفق مع التحية تفقيط إكسيل إنكليزي.rar