نجوم المشاركات

وانت بالف خير تفضل اخي العزيز filter1.rar

وهذا تعديل مع الكود تبعك .... اختر ما شئت ... ومع العايدين Dim db As DAO.Database Dim rs As Recordset Set db = CurrentDb Set rs = db.OpenRecordset("Clients") If Me.txtnomclien <> "" Then If rrr(Me.txtnomclien) = False Then rs.AddNew rs!nomComplet = Me.txtnomclien rs!Societé = Me.txtsociete rs!Adresse = Me.txtadresse rs("Tel") = Me.txttel rs!Email = Me.txtemail rs!Ville = Me.txtville rs.Update rs.Close Set rs = Nothing DoCmd.Close acForm, Me.Name 'DoCmd.Requery Else MsgBox "ce client existe deja", vbInformation Me.txtnomclien.SetFocus End If Else MsgBox "remplir le champ nom de client", vbCritical End If

جرب هذا الكود مع تعديل مسار وجود قاعدة الجداول Dim dbCurrent As DAO.Database Dim recCategories As Recordset Set dbCurrent = OpenDatabase("C:\Users\ACER\Desktop" & "\Nouveau Microsoft Access Base de données.accdb", False) Set recCategories = dbCurrent.OpenRecordset("select * from Clients") With recCategories .AddNew !nomComplet = Me.txtnomclien '!Time = Time .Update End With recCategories.Close dbCurrent.Close Set dbCurrent = Nothing

بعد اذنك أخي واستاذي ابو فريد .... هذه طريقة أخرى 11 (1).mdb

الملف ليس فيه افكار لاقتباسها وانما هي جداول واستعلامات فقط فكيف تطبق الفكرة على برامجك ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟ ليس في الملف بيانات حساسة لذلك نترك الامر للمشرفين

Warning = MsgBox("أنت الآن على وشك حذف السجل الحالي فهل أنت واثق من رغبتك في الحذف", vbYesNo + vbQuestion, "تحذير") If Warning = vbYes Then DoCmd.SetWarnings (False) ضع الكود السابق هنا DoCmd.SetWarnings (True) Else DoCmd.CancelEvent End If

وعليكم السلام لحساب عدد الشيك استخدم هذا الكود =Sum(IIf([غياب]=-1;1;0)) وغياب هو اسم الحقل عندك لحذف السجلات المختارة استخدم هذا الكود CurrentDb.Execute "DELETE * FROM L WHERE [غياب] = true" Me.Requery حيث L هو اسم الجدول لديك

بعد اذن حبيبي سليم للاثراء =SMALL($B$2:$B$14;COUNTIF($B$2:$B$14;"<"&E2)+1) تجريبي 2.xlsx

جرب هذا الملف Tajribi_2.xlsm

ممكن كدا .... R_MultiHead.accdb R_MultiHead.accdb

وعليكم السلام 🙂 يجب ان تعطي الامر بالكامل علشان تحصل على النتيجة المطلوبة ، وعلشان الكود ينكتب بالطريقة الصحيحة ، خلينا نستخدم هذه الاسماء بالانجليزي كمثال: حالة الخدمة= H_Service منقطع = Temp فيكون الكود : Sum_Filed: Sum(iif([H_Service]="Temp",1,0) يعني اذا قيمة الحقل = Temp اجمع لنا 1 (لأن العدد واحد لكل شخص) ، بالعربي المعادلة تنقلب (لهذا السبب فإنه لا يُنصح بإستخدام مسميات عربية في اي من كائنات الاكسس) : . والنتيجة بعد التعديل: . . جعفر AA1.zip

وعليكم السلام 🙂 استعلامين ، وانت اختار اللي تريده : . . جعفر 1226.dtb1.accdb.zip

أخي @Barna اذننا دائما معك ماشاء الله فعلا طريقة جيدة

اسمح لي استاذي @kanory اجاوب ... اخي الحبيب @احمد الفلاحجي في الكود الاول تم الاتصال بالقاعدة الخارجية مباشرة دون النظر الى الجداول المرتبطة ... فلذلك احتجنا كتابة مسار القاعدة المطلوبة اما في الحالة الثانية كان اخي السائل @rey360 كاتب الكود على اساس الاتصال بالقاعدة الحالية فلذلك لم يكن يحتاج لمسار القاعدة الخارجية ... ولكنه عرف المطلوب انه جدول وليس جدول مرتبط فلذلك الكود كان يدور ويبحث عن اسم الجدول Clients ولا يجد ... فقام اخي kanory بحذف عبارة dbOpenTable ارجو اني اوصلت الفكرة انا اضعف منك في اللغة ولم ادرس البرمجة وتحصصي بعيد جدا عن الحاسب ومجالاته .... والحمد لله رب العالمين بفضل الله ثم امثالكم من اساتذة المنتدى تعلمنا بالاضافة لشيئ مهم وهي عملية التطبيق .... بارك الله فيك .... واكرر معذرتي لاخي @kanory

وعليكم السلام-يمكنك استخدام هذه المعادلة =COUNTIF($C$7:$C$12,E$6) تواتي 221.xlsx

ما شاء الله اخي Kanory وكل عام وانت بخير

السلام عليكم اخواني الاعزاء كل عام وانتم بخير اشكر ادارة الموقع علي هذه الثقة الكبيرة وادعو الله ان اكون عند حسن ظنهم اشكر من شرفني بالتهنئة jjafferr kanory ابوخليل ابو تراب kha9009lid أحمد الفلاحجى فايز warvin raviny انا عضو في هذا الموقع منذ زمن طويل لجأت اليه كثيرا في مشكلات واجهتني في اعمالي وكان وما زال ملجأ وملاذ لحل المشكلات المتعلقة بالاكسيس وكنت دائما انظر لفريق الموقع والخبراء باحترام شديد لعلمهم الوافر وسعة صدرهم مع المبتدئين امثالي وتمنيت ان اصبح فردا من ضمن هؤلاء الافذاذ كل التقدير والاحترام لفريق الموقع ولكل الخبراء والاعضاء وزوار الموقع

وعليكم السلام ممكن توضيح اكثر استاذ زوهير

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير اطلب المسامحة ممن راسلني ولم يجد رد مني هديتي لكم بعد هذه الغيبة 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 ================================================= رابط مباشر للملف

كل عام والجميع طيبيين وبخير برنامج دول وعواصم افريقيا تعديل روابط التحميل برنامج دول وعواصم افريقيا رابط البرنامج على موقع Top4top وشغال كويس https://top4top.io/downloadf-1608vsi831-rar.htm

حياك الله اخوي ابو عمار 🙂 ممتاز ، ولكنه كذلك يستعمل جدول مؤقت 🙂 جعفر

الى الان الصورة ليست واضحة بالنسبة لي .. لعل احد الاخوة يفيدنا

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

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

أحسنت استاذ منير عمل رائع ومجهود كبير زادك الله من فضله

الف مبروك و الى الأمام دائما بإذن الله 🌼

عيدك مبارك يعني المطلوب اخفاء ت1 مثلا واظهار ت2 وهكذا .... وضح لو تكرمت

AA1.mdb

تم تجريب ملف الأخ ببن علية حاجي في مشاركته الأولى على اووفيس 2016 و 2019 و الملف يعمل جيدا 100/100. ربما المشكل عندك أاخي وادي سلي. حاول اررسال صورة للخطأ و ان شاء الله سنجد لك الحل

اشكرك اخي ابو بسملة على هذا الحل الرائع والمختصر اعذرني على عدم مشاهدتي لردك الكريم وذلك لعدم ملاحظتي لوجود رد من قبلك اكرر شكري لك حتى لا يذهب مجهودك بدون شكر

اتفضل اخى @nabil2255 المفروض السجلين يظهروا لان البيانات مختلفه بالنسبه للجدول الثانى قمت بتصفيتهم واظهار اعلى تاريخ DMax("d_Aide";"Aide";"benficie=" & [nid]) جزاك الله خيرا اخى ومعلمى العزيز @jjafferr 💐 dtb1.accdb

طبعاً وبالتأكيد لم تصل الفكرة نهائيا وبكده اعتذر عن مساعدتك فكما يبدو لنا انك لا تريد حل مشكلتك لأنك حتى لا تفكر فى تلبية طلباتنا حتى يتم مساعدتك واقل شيء كما قلت لك عليك بوضع شكل النتائج المرجوة بالملف فتم تغيير تاريخ الكمبيونر كما قلت الى 30/06/2020 ثم الضغط على F9 ولكن كما ترى للأسف لم يتغير اى شيء ولم افهم ما تريده نهائياً

الف مبروك للأساتذة @Gamal.Saad و@اشرف على الترقية موفقين ان شاء الله 🌹🌹.

يا فرحة العيد الف مبروك للاساتذه @Gamal.Saadو @اشرف

بالخدمة استاذي العزيز

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

شكراً لاستاذنا جعفر على العيدية المميزة والف مبروك للاخوة الافاضل @اشرف و @Gamal.Saad على الترقية راجياً من الله للجميع دوام التوفيق تحياتي

الف مبروك لكل من :- استاذ Gamal.Saad استاذ اشرف دوام يارب التوفيق و التقدم كل تحياتى

تمام ....... أيها الأستاذ المحترم بارك الله فيك

انظر للتقرير St_Jloss_Qury مع العلم أن هناك غموض في طلبك .. وحتى يكون الأمر واضحا .. أضف في الجدول جميع الحقول التي تريد . أنت طلبت السؤال : أين هو حقل المادة في الجدول ؟؟؟؟؟ وهنا تقول : ثم بعدها تقول وكيف تكون طريقة ادخال البيانات ؟؟ هل هي عن طريق الجدول مباشرة ؟؟ أم عن طريق نموذج ؟؟ توزيع.mdb

ايضا هذا كود اخر جميل وتعدد الخيارات بمجرد تشغيل تستطيع تحدد العمود الذي تريد من تحدف منه البيان وكذلك الكلمة او القيمة التي تريدها Sub DeleteRows() 'Updateby20140314 Dim rng As Range Dim InputRng As Range Dim DeleteRng As Range Dim DeleteStr As String xTitleId = "KutoolsforExcel" Set InputRng = Application.Selection Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8) DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2) For Each rng In InputRng If rng.Value = DeleteStr Then If DeleteRng Is Nothing Then Set DeleteRng = rng Else Set DeleteRng = Application.Union(DeleteRng, rng) End If End If Next DeleteRng.EntireRow.Delete End Sub

كل المعادلات عادية (بدون CTRL+SHIFT+ENTER) اذا اردت ان يكون تاريخ البداية والنهاية ضمن المجموع =SUMPRODUCT(($D$4:$D$13<=$I$4)*($D$4:$D$13>=$G$4)) اذا اردت ان لا يكونا ضمن المجموع =SUMPRODUCT(($D$4:$D$13<$I$4)*($D$4:$D$13>$G$4)) اذا اردت ان يكون احدهما ضمن الموحوع ( الأصغر فقط أو الأكبر فقط) =SUMPRODUCT(($D$4:$D$13<=$I$4)*($D$4:$D$13>$G$4))

مشاركة مع الاخوة الاحبة ..... عسى أن يكون الكود قصيرا .... تفضل Aziz (2).rar

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

السلام عليكم اخى @f16 مشاركه مع اخى واستاذى محمد @أبو عبدالله الحلوانى جزاه الله خيرا ارفق حل بدون اللجوء الى استعلام التحديد والتجميع وهو بداله Dsum فى استعلام التحديث DSum("num";"request";"item_id=" & [item_id]) اضف سجل جديد بالجدول request لاى رقم من الموجودين بالجدول مثال 101 او 102 ثم استخدم استعلام التحديث يمكن عمل استعلام الحاقى بعد ذلك لاضافه السجلات الجديده بالجدول request للجدول story مع عدم تكرار السجلات المدخله من قبل تقبلوا تحياتى وارجو لكم وللجميع التوفيق والنجاح مثال_اوفيسنا_استعلام_تحديث_من_استعلام_تجميع(1).accdb

جرب هذا الملف (الصفحة Target_sh ) الكود Option Explicit Sub Get_data() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim D As Worksheet, T As Worksheet Dim D_Rg As Range, T_rg As Range, Single_rg As Range Dim RoD%, RoT%, All_ro%, X%, y% Dim Nme$ Set D = Sheets("Data"): Set T = Sheets("Target_sh") Set D_Rg = D.Range("A4").CurrentRegion Set T_rg = T.Range("A3").CurrentRegion RoT = T_rg.Rows.Count If RoT > 1 Then _ T_rg.Offset(1).Resize(RoT - 1).Clear If D.FilterMode Then D_Rg.AutoFilter RoD = D_Rg.Rows.Count Set Single_rg = D_Rg.Offset(1).Resize(RoD - 1) Nme = T.Cells(3, "K") D_Rg.AutoFilter 4, Nme D_Rg.AutoFilter 3, "اجل" y = D_Rg.SpecialCells(12).Rows.Count If y > 0 Then Single_rg.Columns(2).SpecialCells(12).Copy T.Range("A4").PasteSpecial (12) Single_rg.Columns(8).SpecialCells(12).Copy T.Range("B4").PasteSpecial (12) End If D_Rg.AutoFilter D_Rg.AutoFilter 4, Nme D_Rg.AutoFilter 3, "نقدا" X = D_Rg.SpecialCells(12).Rows.Count If X = 0 Then Exit Sub Single_rg.Columns(2).SpecialCells(12).Copy T.Range("C4").PasteSpecial (12) Single_rg.Columns(8).SpecialCells(12).Copy T.Range("D4").PasteSpecial (12) All_ro = T.Range("A3").CurrentRegion.Rows.Count With T.Cells(All_ro + 3, 1) .Value = "المجموع:" .Offset(, 1) = Evaluate("=SUM(B4:B" & All_ro + 2 & ")") .Offset(, 2) = "المجموع:" .Offset(, 3) = Evaluate("=SUM(D4:D" & All_ro + 2 & ")") End With With T.Cells(4, 1).Resize(All_ro, 4) .InsertIndent 1: .Borders.LineStyle = 1 .Font.Size = 13: .Font.Bold = True .Interior.ColorIndex = 38 End With If D.FilterMode Then D_Rg.AutoFilter With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف مرفق Mabieat_Filter.xlsm

اخي عامر تفضل لعله المطلوب لقد قمت بصياغة الملف وتسمية الاوراق بالانجليزي حتى يعمل الكود جيدا Sub copypaste() Dim lastrow As Integer, erow As Integer, sh1 As Worksheet, sh2 As Worksheet Set sh1 = Worksheets("sheet2") Set sh2 = Worksheets("sheet4") lastrow = sheet2.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lastrow erow = sheet4.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row sheet4.Cells(erow, 5) = sheet2.Cells(i, 1) sheet2.Cells(i, 1).ClearContents sheet4.Cells(erow, 3) = sheet2.Cells(i, 2) sheet2.Cells(i, 2).ClearContents sheet4.Cells(erow, 7) = sheet2.Cells(i, 5) sheet2.Cells(i, 5).ClearContents Next i ThisWorkbook.Worksheets("sheet4").Columns().AutoFit lastrow = sheet3.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lastrow erow = sheet4.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row sheet4.Cells(erow, 2) = sheet3.Cells(i, 1) sheet3.Cells(i, 1).ClearContents sheet4.Cells(erow, 4) = sheet3.Cells(i, 2).Formula sheet3.Cells(i, 2).ClearContents sheet4.Cells(erow, 6) = sheet3.Cells(i, 4) Next i ThisWorkbook.Worksheets("sheet4").Columns().AutoFit End Sub tarheel‬.xls

السلام عليكم ورحمة الله وبركاتةإخواني الاعزاء اقدم لكم ملف مفيد فى تحويل الارقام الى حروف*** المميزات ***هو ان الملف بدون وحدات ماكرو كما انة معد لاستخدام كل العملات العربية والاجنبية يدعم التفقيط بالعربي والانجليزيمهتم باصول اللغة العربية فى الجمع والمثنيهذا الملف يدعم تفقيط 500 رقم مختلف فى وقت واحد واخيرا ارجوا منكم تدعوا لى ولوالدي عسي الله ان ينفعنا بما علمناWithout macros find how to convert 500 numbers into text click here Convert numbers into words.rar

السلام عليكم ... جرب الصيغة التالية: =INDIRECT("[mah]"&SheetsCount(2)&"!"&"D4") التي تقوم بإرجاع قيمة الخلية D4 الموجودة في الورقة الثانية من المصنف mah. ملاحظة : يجب أن يكون المصنف mah مفتوحاً وإلا فإن التعليمة INDIRECT ترجع الخطأ #REF! تحياتي

السلام عليكم ... ليش العذاب يا أخي ؟!!! بحثت لك في دوال الاكسل الجاهزة و لم أجد مبتغاك. على أية حال فقد أنشئت لك الدالة SheetsCount : أولاً قم بوضع الكود التالي في الموديل: Function SheetsCount(Index As Integer) As String SheetsCount = Sheets(Index).Name End Function الدالة السابقة تقوم بإرجاع اسم الورقة بناءاً على ترتيبها. الآن اذهب إلى ورقة العمل واستخدم هذه الدالة مع الدالة INDIRECT في وضع هذه الصيغة: =INDIRECT(SheetsCount(2)&"!"&"D4") بالتوفيق SheetsCount.zip