ابو مارفن

شكراً جزيلاً لك استاذ عبدالله المبدع الله يحفظك ويجعلها في ميزان حسناتك ويسعد ايامك تحياتي لجنابك الكريم

عاشت ايدك وبارك الله بيك وبجهودك استاذ احتاج ان يعمل الكود على كل صفحات الملف مثلا 10صفحات ويضيف الصوره فيها مهما كان امتدادها ما عدا صفحات التي تكون باسم ورقة3 وورقة6 لا يضيف الصوره فيها مع جزيل الشكر لمجهودك

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

السلام عليكم شلونكم بدون زحمة اريد ان اضيف خاصيه الى الصوره المدرجة من خلال الكود كما هو موضح بالصورة المرفقة مع جزيل الشكر والتقدير Private Sub Comm() Dim ws As Worksheet For Each ws In Worksheets ws.Pictures.Insert ("D:\عنوان.jpg") Next End Sub ادراج صورة.xlsm.xlsx

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

السلام عليكم فضلا وليس امرا محتاج في ملف المجموع ان يكون مجموع خلايا الكلي للعمودF من الملف الاعمده في الخليه C2 ومجموع خلايا العمودF التي تقابل كلمة Q10R و Q50R في العمود K في الخلية C3 ومجموع خلايا العمود F التي لا تقابل كلمة Q10R و Q50R في العمود k في الخلية C4 ويقابلها مجموع الخلايا التي تم جمعها F2 و F3 و F4 علما ان الخلايا كثيره في ملف الاعمدة.. مع جزيل الشكر والتقدير مجموع.xlsx الاعمده.xlsx

للرفع

Private Sub Worksheet_Change(ByVal Target As Range) 'لادراج بيانات الاسم في حال تكراره If Target.Column = 2 And Target.Row > 1 Then Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlManual Dim rw& On Error Resume Next rw = Range("q:q").Find(Target.Value, Target, , 1, , 2).Row Target.Offset(, 1).Value = Cells(rw, 3).Value Target.Offset(, 2).Value = Cells(rw, 4).Value Target.Offset(, 3).Value = Cells(rw, 5).Value Target.Offset(, 4).Value = Cells(rw, 6).Value Target.Offset(, 5).Value = Cells(rw, 7).Value Target.Offset(, 6).Value = Cells(rw, 8).Value Target.Offset(, 7).Value = Cells(rw, 9).Value Target.Offset(, 8).Value = Cells(rw, 10).Value Target.Offset(, 9).Value = Cells(rw, 11).Value Application.Calculation = xlAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub

السلام عليكم فضلا وليس امرا تعديل على كود في حد الصفحة لجلب بيانات الموظف في حال تكرار الاسم مع جزيل الشكر بيانات الموظف.xlsm.xlsx

اللهم إنا نسألك بأسمائك الحسنى وبصفاتك العلا وبرحمتك التي وسعت كلّ شيء، أن تمنّ عليه بالشفاء العاجل، وألّا تدع فيه جرحاً إلّا داويته، ولا ألماً إلا سكنته، ولا مرضاً إلا شفيته، وألبسه ثوب الصحة والعافية عاجلاً غير آجل، وشافِه وعافِه واعف عنه، واشمله بعطفك ومغفرتك، وتولّه برحمتك يا أرحم الراحمين.َ

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

الملف المرفق Option Explicit '========================================================" ' بسم الله الرحمن الرحيم " ' تم تحميل هذا الكود من الرابط التالي ' http://www.officena.net/ib/topic/39447-%D8%AF%D8%A7%D9%84%D8%A9-%D8%AA%D9%81%D9%82%D9%8A%D8%B7-%D8%AA%D8%AD%D9%88%D9%8A%D9%84-%D8%A7%D9%84%D8%B1%D9%82%D9%85-%D8%A7%D9%84%D9%89-%D9%86%D8%B5-%D8%A8%D8%A7%D9%84%D8%B9%D8%B1%D8%A8%D9%8A-%D8%B7%D9%88%D9%84-%D8%A7%D9%84%D8%B1%D9%82%D9%85-%D8%BA%D9%8A%D8%B1-%D9%85%D8%AD%D8%AF%D9%88%D8%AF/ ' الكود من كتابة السيد عبد الله باقشير بتاريخ 27/11/2011 ' تم التعديل على اسم الكود مع القيم الافتراضية للتتناسب مع العملة السعودية ' كذلك تم تعديل ترتيب مدخلات الدالة لسهولة الحفظ للمستخدم النهائي ' تم التعديل من قبل حسين بلال بتاريخ 22/2/2016 ' husseinb[at]viaexcel.com ' www.viaexcel.com ' CurrText '========================================================" ' (دالة تحويل الرقم الى نص باللغة العربية (تفقيط " ' kh_TextNum " '========================================================" 'Num الرقم " '========================================================" 'Sex جنس العملة " ' FALSE ( أو فارغ او صفر مذكر ) " ' TRUE ( أو اي رقم غير الصفر مؤنث ) " '========================================================" 'NCurr_Si اسم العملة الرئيسية مفرد " 'NCurr_Pl اسم العملة الرئيسية جمع " 'NCurrDec_Si اسم العملة الكسرية " 'Decimal_Count طول الكسر افتراضـياً : بدون اظهار الكسر " '========================================================" ' : للدلالة على تفقيط الكسر عين التالي " 'NCurrDec_pl اسم العملة الكسرية جمع " 'dSex جنس عملة الكسر " ' FALSE ( أو فارغ او صفر مذكر ) " ' TRUE ( أو اي رقم غير الصفر مؤنث ) " '========================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ' ملاحظات ' (اولاً : اذا اسم العملة ينتهي بالتاء المربوطة ' يجب ان يكتب كذلك وليس بالهاء ' ----------------------- ' ثانياً : العملة الافتراضية هي العملة السعودية ' وجنس العملة والكسر مؤنث ' ----------------------- '("" ثالثاً : امكانية إضافة كلمة بداية ونهاية النص (فارغة Private Const MyBegTx As String = "فقط " Private Const MyEndTx As String = " لاغيرها" ' ----------------------- ' MyTNum رابعا : يمكنك التغيير (اضافة,حذف,تحرير) في الثابت ' للفئات الصفرية للرقم ادناه Private Const MyTNum As String = "الف-الاف/مليون-ملايين/مليار-مليارات/بليون-بلايين/بليار-بليارات/ترليون-ترليونات/تريليار-تريليارات/كدرليون-كدرليونات" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" Private Const wow As String * 2 = " و" '===============================================================================================================================================" Function melad(Num As String, _ Optional Sex As Boolean = False, _ Optional NCurr_Si As String = "دينار", _ Optional NCurr_Pl As String = "دينار", _ Optional dSex As Boolean = False, _ Optional NCurrDec_Si As String = "فلس", _ Optional NCurrDec_Pl As String = "فلس", _ Optional Decimal_Count As Byte = 3) _ As String '====================================== Dim Spp, zt Dim i%, ii%, pr% Dim MyMid$, nCurr$, Txt$, Txt1$, Txt2$ '====================================== If Not IsNumeric(Num) Then GoTo kh_Exit If Num = 0 Then Txt = MyBegTx & "صفر " & NCurr_Si: 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 = NCurr_Si & "-" & IIf(NCurr_Pl = "", NCurr_Si, IIf(NCurr_Si = "", "", NCurr_Pl)) '====================================== 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), 1) Txt2 = IIf(ii - i, Trim(Spp(ii - i)), nCurr) pr = 1 + IIf(ii - i, 1, CInt(Sex)) Txt = Txt & IIf(Len(Txt), wow, "") & kh_nText(MyMid, Txt2, pr, zt, CBool(NCurr_Si <> "")) End If If i = ii Then If MyMid = 0 Then Txt = Txt & IIf(Len(Txt), " " & NCurr_Si, IIf(Decimal_Count = 0, "صفر", "")) Next '====================================== Txt = MyBegTx & Txt & kh_dText(Num, NCurr_Si, Trim(NCurrDec_Si), Decimal_Count, Trim(NCurrDec_Pl), dSex) & MyEndTx '====================================== kh_Exit: melad = 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, "") & wow & nT1 If Num2 = 0 Then nT2 = nT1 nT = nT2 End Select '====================================== S = IIf(nT = "" Or iNum < 100, "", wow) 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, ByVal Ndec_pl As String, ByVal dsx As Boolean) As String Dim Td$, dwow$, Td1$ On Error GoTo 1 If co = 0 Then 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 Int(dNum) Then dwow = wow If Len(Ndec) Then Ndec = " " & Ndec Td1 = Td * CVar("1" & String(co, "0")) If Len(Ndec_pl) And co < 4 Then Td1 = dwow & kh_nText(Format(Td1, "000"), Ndec & "-" & Ndec_pl, 1 + CInt(dsx), 1, 0): GoTo 1 Else Ndec = " " & NCur: Td1 = Td End If Td1 = dwow & " " & Chr(40) & Td1 & Chr(41) & Ndec 1: kh_dText = Td1 End Function تفقيط الرقم.xlsm

السلام عليكم ممكن التفضل بتعديل كود تفقيط المبلغ 101000 فقط مائة الف والف دينار لاغيرها 102000 فقط مائة الف والفا دينار لاغيرها مع جزيل الشكر تفقييط.xlsx

ابحث في المواضيع المثبتة تحتوى على شرح مفصل

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