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

السلام عليكم ورحمة الله جرب هذه الدالة المخصصة Function SepLetrs(Cel As Range) As String Dim Arr, Tmp, Word, Strg Dim i As Long, j As Long Arr = Array("ا", "ب", "ت", "ث", "ج", "ح", "خ", "د", "ذ", "ر", "ز", "س", "ش", "ص", _ "ض", "ع", "غ", "ط", "ظ", "ف", "ق", "ك", "ل", "م", "ن", "ه", "و", "ي", "ى", "ة") Tmp = Array("الف", "باء", "تاء", "ثاء", "جيم", "حاء", "خاء", "دال", "ذال", _ "راء", "زين", "سين", "شين", "صاد", "ضاد", "عين", "غين", "طاء", "ظاء", _ "فاء", "قاف", "كاف", "لام", "ميم", "نون", "هاء", "واو", "ياء", "ياء", "تاء مربوطة") For i = 1 To Len(Cel) Word = Mid(Cel, i, 1) For j = LBound(Arr) To UBound(Arr) If Word = Arr(j) Then Strg = Strg & " " & Replace(Word, Arr(j), Tmp(j)) End If Next Next SepLetrs = Strg End Function

جرب هذا النموذج (فقط اضغط على الزر Sort Please) Option Explicit Sub Creezy_Sort() Dim arr, itm, k% Dim txt Dim Col As Object Set Col = CreateObject("System.Collections.Sortedlist") With Sheets("Salim") arr = .Range("A1").CurrentRegion arr = Application.Transpose(arr) .Range("C1").CurrentRegion.ClearContents For Each itm In arr If InStr(itm, ":") Then txt = Split(itm, ":") If UBound(txt) = 1 Then Col.Add CStr(txt(1)), CStr(txt(0)) End If End If Next itm If Col.Count Then For k = 0 To Col.Count - 1 .Cells(1, 3).Offset(k) = _ Col.GetByIndex(k) & ":" & Col.GetKey(k) Next End If End With End Sub الملف مرفق ellatef.xlsm

أهلا يك أ. عطا عن طريق زر الأمر لا أعتقد.. لكن إذا كنت تستخدم أكسس 2007 فما فوق.. يمكن أن يكون الحل في المرفق مقبولا.. azizz.accdb

جرب هذا الماكرو 1- الماكرو يظهر معاينة قبل الطباعة من اجل الطياعة مباشرة استيدل السطر Sh.PrintPreview بالسطر Sh.PrintOut Option Explicit Sub Print_all() Dim Sh As Worksheet Dim k% Application.EnableEvents = False Set Sh = Sheets("الربع") Sh.PageSetup.PrintArea = "$B$2:$L$21" For k = 26 To 81 If Sh.Range("C" & k) <> "" Then Sh.Range("D5") = Sh.Range("C" & k) Sh.PrintPreview 'Sh.PrintOut End If Next k Sh.PageSetup.PrintArea = "" Application.EnableEvents = True End Sub الملف مرفق Alaa.xlsm

السلام عليكم فضلا انظر للمرفق مع الشكر ترتيب الوقت.xls

الفكرة تحفة يابو ابراهيم سلمت أناملك لاحظت انه عند ادراج بيانات جديدة او تعديل الحقل yn لا تستجيب الصورة للحدث اعتقد يحتاج الحقل yn بعد التحديث الى تنشيط الفورم بــ Refresh أو نحو ذلك

يلزم التحايل على السجلات وتحديد الترتيب عند فتح النموذج المنبثق Dim j As Integer Private Sub Command3_Click() DoCmd.GoToRecord , , acFirst DoCmd.OpenForm "form2" ifrm = 1 j = 1 End Sub Private Sub Form_Timer() On Error GoTo ErrHandler Dim i As Integer, R As Integer Dim rs As Recordset Set rs = Me.RecordsetClone R = rs.RecordCount If j = 1 Then DoCmd.GoToRecord , , acFirst j = 0 ElseIf ifrm = 1 And j = 0 Then DoCmd.GoToRecord , , acNext End If For i = 1 To R - 1 If ifrm = 1 Then DoCmd.OpenForm "form2" ifrm = 0 End If Next ErrHandler: If Err.Number = 2105 Then ifrm = 0: Exit Sub End Sub help3.mdb

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

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

تفضل التعديل اخي الكريم سيتم ترقية من تم تحديده فقط الترقيات.zip

يمكنك استخدام هذا البرنامج الموجود بهذا الرابط وذلك بما انك قمت برفع الملف محمى بكلمة سر كما انك قمت برفع الملفات فارغة بدون اى بيانات: برنامج دمج ملفات الإكسيل فى ملف واحد Excel Merger أو يمكنك استخدام هذا الكود Sub MergeExcelFiles() Dim fnameList, fnameCurFile As Variant Dim countFiles, countSheets As Integer Dim wksCurSheet As Worksheet Dim wbkCurBook, wbkSrcBook As Workbook fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True) If (vbBoolean <> VarType(fnameList)) Then If (UBound(fnameList) > 0) Then countFiles = 0 countSheets = 0 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set wbkCurBook = ActiveWorkbook For Each fnameCurFile In fnameList countFiles = countFiles + 1 Set wbkSrcBook = Workbooks.Open(FileName:=fnameCurFile) For Each wksCurSheet In wbkSrcBook.Sheets countSheets = countSheets + 1 wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count) Next wbkSrcBook.Close SaveChanges:=False Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files" End If Else MsgBox "No files selected", Title:="Merge Excel files" End If End Sub

تفضل ربما يكون المرفق ما تريد الاكواد اظنها للاستاد ياسر ابو البراء جزاه الله خير الجزاء قمت بتعديلها حسب طلبك قوائم مترابطة (2).xlsm

اتفضل هذا مثال لإرسال المرفقات لأي استفسار انا في الخدمة ارسال الصور.rar باقي المرفقات تتم بنفس اسلوب ارفاق الصور يتم تحويل المرفق الى بيانات و يتم تخزينها في الذاكرة المؤقته و من ثم يتم لصقها في تطبيق الواتساب

عندي يعمل بشكل طبيعي انظر الضورة seaf Extra1.xlsm

السلام عليكم ورحمة الله يمكنك استخدام هذه الدالة المعرفة و هى تعطى الترتيب من الاول حتى العاشر فقط مع التكرار Function RRank(Cel As Range, Rang As Range) As String 'Cel : اول خلية فى نطاق الدرجات ' Rang : -F4- النطاق الذى سوف يتم البحث فيه ويجب تثبيته باستخدام مفتاح '---------------------- Dim Obj As Object, I As Long, Arr As Variant Dim temp As Variant, Itm As Variant, Rnk As Integer Dim x As Integer, k As Integer, MK As String, xx As String '================ Set Obj = CreateObject("Scripting.Dictionary") Arr = Rang.Value For Each Itm In Arr If Obj.exists(Itm) Then Obj.Item(Itm) = Obj.Item(Itm) + 1 Else Obj.Add Itm, 1 End If Next temp = Obj.keys I = Obj.Count '================ If I <= 10 Then k = I Else: k = 10 End If For n = 1 To k Rnk = WorksheetFunction.Large(temp, n) If Cel.Value = Rnk Then If n >= 1 And n <= 10 Then xx = Choose(n, "الاول", "الثانى", "الثالث", "الرابع", "الخامس", _ "السادس", "السابع", "الثامن", "التاسع", "العاشر") trb = xx Else trb = "" End If End If Next '================= m = WorksheetFunction.CountIf(Range(Rang.Cells(1, 1), Cel), Cel) If m > 1 And Cel.Value >= Rnk Then MK = " مكرر" Else MK = "" End If '================= RRank = trb & MK End Function

فيديوووو جديد جديد جديد كتير مننا بيبقى عندنا قائمة باسماء ،ومطلوب منك تترجمها للعربي او للنجليزية وبرضة ممكن تترجم نص من العربية إلى الانجليزية والعكس وبرضة تقدر تعمل QR لقناتك - لاسمك - لرقم تليفونك - لموقعك رابط معادلة ال QR https://docs.google.com/d*ocument/d/1OVRibIQwsr255-fCutlzY6hnDcvB6R2lKwiGT-_hSwE/edit https://www.youtube.com/watch?v=c2B-_-j9GeU&t=8s

السلام عليكم ،، السادة الافاضل برجاء من حضراتكم المساعده فى الشرح كيفية عمل يوزرفورم استخراج بيانات الرقم القومى بالاضافة الى تاريخ الاحالة الى سن المعاش بفرض ان السن 60 عام وذلك عند كتابة الرقم القومى يتم ظهور كل البيانات المطلوبة تاريخ الميلاد / السن / المحافظة /تاريخ الاحالة المعاش تم تحميل من المنتدى ملف ذ / مجدى يونس مشكورا ربنا يجزيه خير بنفس الفكرة ولكن يعتمد على الترحيل البيان فصعب على الامر فى عمل نفس الفورم ومرفق الملف لمعرفه فورم المستخدم برجاء المساعده فى عمل الفورم كما بالصوره الاولى مع شرح كيفية العمل وشكرا لحضراتكم 6 تاريخ الميلاد والسن والنوع.xlsm id 2.xlsm

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

تم معالجة الامر بالكامل Sub fil_Profname() Application.ScreenUpdating = False Dim p As Worksheet, T As Worksheet, G As Worksheet Dim x%, xx%, m%, how_many%, r%, i%, y%, mun%: num = 1 Dim resl As Range, F_rg As Range Dim Mth As Range, arr(), cel As Range Dim D_arr() Set p = Sheets("P"): Set T = Sheets("T") Set G = Sheets("GHIAB") Set resl = G.Range("a5").CurrentRegion r = resl.Rows.Count If r > 1 Then resl.Offset(1).Resize(r - 1).Clear x = 4: m = 6 Do Until p.Range("a" & x) = vbNullString '====================================== how_many = Application.CountIf(p.Range("D" & x).Resize(, 500), "Ok") If how_many = 0 Then GoTo Next_x Set Mth = G.Range("P12:P23").Find(G.Range("P5")).Offset(, 1) first = Application.Match(Mth, p.Cells(500, "d").Resize(, 250), 0) + 3 y = Application.CountIf(p.Rows(500), Mth) For Each cel In p.Cells(3, first).Resize(, y) If Month(cel) = Mth And UCase(cel.Offset(x - 3)) = "OK" Then ReDim Preserve arr(1 To num) ReDim Preserve D_arr(1 To num) arr(num) = CDate(cel) D_arr(num) = cel.Offset(-1) num = num + 1 End If Next If num > 1 Then G.Cells(m, 1).Resize(num - 1) = Application.Transpose(arr) G.Cells(m, 2).Resize(num - 1) = Application.Transpose(D_arr) For i = 1 To num - 1 G.Cells(m + i - 1, 3) = p.Cells(x, 1) G.Cells(m + i - 1, 4) = p.Cells(x, 2) G.Cells(m + i - 1, 5) = p.Cells(x, 3) Next m = m + num - 1 End If Erase arr: Erase D_arr: num = 1 Next_x: x = x + 1 Loop Set resl = G.Range("a5").CurrentRegion r = resl.Rows.Count If r = 1 Then Exit Sub Set resl = resl.Offset(1).Resize(r - 1) With resl .InsertIndent 1 .Borders.LineStyle = 1 .Font.Bold = True .Font.Size = 14 End With MADDA Application.ScreenUpdating = True End Sub '================================ Sub MADDA() Dim T As Worksheet, G As Worksheet Dim x%, xx%, m%, r1% Dim F_rg As Range Set T = Sheets("T") Set G = Sheets("GHIAB") x = 6: m = 6 Do Until G.Range("A" & x) = vbNullString xx = T.Rows(1).Find(G.Range("B" & x)).Column Set F_rg = T.Columns(1).Find(G.Range("C" & x), lookat:=1) If F_rg Is Nothing Then GoTo Next_x r1 = F_rg.Row G.Cells(m, 6).Resize(, 8).Value = _ T.Cells(r1, xx).Resize(, 8).Value m = m + 1 Next_x: x = x + 1 Loop End Sub الملف medSalim_Final.xlsm

الاخوة الزملاء السلام عليكم ورحمة الله وبركاتة برنامج مجاني علي الاكسيل لاقرار ضريبة القيمة المضافة برنامج سهل وبسيط خصائص البرنامج غلق جميع الخلايا التي تحتوي علي معادلات حفظ البيانات بمجرد الخروج العودة للقائمة الرئيسية في كل مرة يتم فتح البرنامج فيها استخدام اوامر الطباعه في الشيت الخاص بالاقرار التقارير إقرار ضريبة القيمة المضافة نموذج10 الخاص بكل شهر التحليل الشهري لفواتير المبيعات والمشتريات تفريغ الاقرارات user : How To Excel password: hte إقرار ضريبة القيمة المضاف 2.0.rar

May 2015 - 08:42 AM أسعد الله أوقاتكم بكل خير حتى تتم الاستفادة بالشكل الأمثل فقد تم رفع ملفات التمارين الخاصة بدورة الاكسيل 2013 حتى يتسنى للجميع تطبيق الدروس بشكل عملي مع الاحترام ملفات التمارين لدورة اكسيل 2013 لمشاهدة دروس دورة الاكسيل 2013 المنشورة يرجى فتح ا لرابط التالي: دمتم بخير أخوكم م/نضال الشامي Google+ Twitter

الملف المرفق به مثالين أحدهما للأخ طارق و الثاني للأخ أبو هادي و قد شارك فى خطوات اعداد المثال أشرف و أبو هاجر و المثالين هما آخر تطوريرات النموذج الاول ( مثال طارق ) للتقويم الميلادي و الثاني ( مثال أبو هادي ) للتقويم الهجري و الميلادي و أم القري مع الشكر لهم جميعا :d ملاحظة : المثال المرفق عدل ليشمل ملف طارق فقط ، بعد إضافة أبو هادي للنسحة الأخيرة من مثاله فى المشاركة التالية : Calender.rar

اخى العزيز اليك هذا الكود ويوضع فى حدث الورقة المراد حماية المعادلات بها Private Sub Worksheet_Selectionchange(ByVal Target As Range) If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select End Sub

الصيغة Select * from main UNION Select * from الأجازات UNION Select * from منتدبون_كليا_للخارج UNION Select * from انتهى_ندبهم_للمدرسة; Select * from main UNION Select * from الأجازات UNION Select * from منتدبون_كليا_للخارج UNION Select * from انتهى_ندبهم_للمدرسة;

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

1. لدي تصميم لنمودج وبه أزرار اختيار , ولكن أزرار الاختيار تبقى على حالتها التي تكون عليها في أول سجل عندم أنتقل لسجل آخر. كيف أستطيع أن أتمكن من اختيار الزر المناسب لكل سجل , بحيث يستقل كل سجل بوضعه؟

السلام عليكم لدي قاعدة بيانات على الأكسيس وفيها سندات قبض .. ولدي طابعة نقطية ( أبسون LQ 300 ) .. والسندات عندي مطبوعة على أوراق مخرمة ... مقاس A4 وفي كل ورقة سندين قبض ... السؤال : كيف أستطيع أن أجعل الطابعة المذكورة تقف عن منتصف الورقة ( اي نهاية السند الأول ) .. ثم تطبع السند الثاني وتقف عند نهايته وهكذا ... فهل هناك إعدادت معينة ..؟؟!!

السلام عليكم ورحمة الله وبركاته [move] الأخوة الكرام أحتاج لشرح كيفية عمل الماكرو وأوامره ووظائف الأوامر لاني قائم على عمل قواعد بيانات وأحتاجها حاجة ماسة لتقوية القواعد التي أقوم بها . ولم أجد حتى الآن كتاب أو موقع يشرح لي وحدات ماكرو لا في الكتب ولا في المنتديات فأرجو منكم المساعدة وجزاكم الله خيرا

السلام عليكم بافتراض أن الـ text box إسمه Text1 نضع في حدث عند التبديل : Private Sub Text1_Change() If Len(Me.Text1.Text) > 6 Then SendKeys "{BS}" Beep End If End Sub أو يمكن الكتابة في الـ Validation Rule كالتالي : Len([Text1])<=6 تحياتي .

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

جزا الله كل خـير ادارة هذا المنتدى والسادة مشرفين هذا القسم كل خـــير ففي امثلتهم التي يضعونها لنا (اي الملفات التي ترفق مع اجوبتهم) نجد الكثير من الاشياء التي نتعلمها (وقل ربي زدني علماً). ففي مثال الاستاذ محمد طاهر في موضوعي {التقريب الي درجة محددة} وضع ملف مرفق ووجدتة وضع كود ضمن ال TextFile في الفورم في After Update وضع Me.Refresh فما عمل هذا الكود وبماذا يخدم وجودة . السادة المشرفين ارجوا ان اكون قد قمت بفعل الصحيح حول فصل سؤالي هذا عن موضوعي السابق (الرجاء التنوية حول ذلك)

If IsNull (Me.__________ ) = True Then Me.__________.Visible = no Me.__________.Visible = no End If في الفراغين اللذين في السطر الأول والثاني يكتب اسم الحقل المراد إخفاؤه إذا كانت القيمة فارغة في الفراغ الذي في السطر الثالث يكتب اسم التسمية الخاص بالحقل الأول ويكتب الكود في خانة الــActivate