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

تفضل هذه الطريقة استخدمها مع الاستعلام و النماذج و التقارير مرفق التعديل Public Function Total_Duplicate(Eployee_ID As Integer) As Integer Dim TbName As String Dim Sheft1, Sheft2, Sheft3, Sheft4, Sheft5 As Integer TbName = "جدولدوام" Sheft1 = DCount("*", TbName, "[موظف1]=" & Eployee_ID) Sheft2 = DCount("*", TbName, "[موظف2]=" & Eployee_ID) Sheft3 = DCount("*", TbName, "[موظف3]=" & Eployee_ID) Sheft4 = DCount("*", TbName, "[موظف4]=" & Eployee_ID) Sheft5 = DCount("*", TbName, "[موظف5]=" & Eployee_ID) Total_Duplicate = Sheft1 + Sheft2 + Sheft3 + Sheft4 + Sheft5 End Function عدد تكرار كل موظف.rar

يمكنك استعمال هذا الكود Sub rng2jpg(Rng As Range) Dim Chrt As ChartObject Rng.CopyPicture xlScreen, xlPicture Set Chrt = ActiveSheet.ChartObjects.Add(Left:=0, Top:=0, Width:=Rng.Width, Height:=Rng.Height) Chrt.Activate With Chrt.Chart .Paste .Export Filename:=ThisWorkbook.Path & "\mas.jpg", Filtername:="JPG" End With oChrtO.Delete MsgBox "Done by mr-mas.com" End Sub ولاستدعائه Sub mas() rng2jpg Range("a1:f20") End sub وتم فصل الإجراءين لسهولة التعامل مع الكود في أكثر من شيت ويمكن الاستغناء عن الإجراء الثاني إذا أضفنا تحديد النطاق إلى الإجراء الأول كما في السطر الثالث ليصبح Sub rng2jpg() Dim rng As Range, Chrt As ChartObject Set Rng = Range("a1:f20") Rng.CopyPicture xlScreen, xlPicture Set Chrt = ActiveSheet.ChartObjects.Add(Left:=0, Top:=0, Width:=Rng.Width, Height:=Rng.Height) Chrt.Activate With Chrt.Chart .Paste .Export Filename:=ThisWorkbook.Path & "\mas.jpg", Filtername:="JPG" End With Chrt.Delete MsgBox "Done by mr-mas.com" End Sub بالتوفيق

يجب عليك تحديد ارقام الخطأ و وضع التصحيح لها كأفضل طريقة للتعامل مع الخطأ تفضل استخدم و سجل الأخطاء المحتملة و ضع لها الحلول المناسبة On Error GoTo ErrH ضع الكود كامل هنا Exit Sub ErrH: Select Case Err.Number Case = 0 ' رقم الخطأ ' ضع الإجراء التصحيحي للخطأ Case = 0 ' رقم الخطأ ' ضع الإجراء التصحيحي للخطأ End Select

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

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

تفضل الملف 2003 TEST_OD _2003.mdb

Sub Test() With ActiveSheet .PageSetup.CenterFooter = Format(Date, "dd-mm-yyyy") .PrintPreview End With End Sub

Option Explicit Const col As Long = 4 Private Sub UserForm_Initialize() Dim i As Long With ThisWorkbook.Worksheets(1) If Application.WorksheetFunction.Count(.Columns(col)) > 1 Then For i = 2 To .Cells(Rows.Count, col).End(xlUp).Row ListBox3.AddItem .Cells(i, col).Value Next i End If End With TextBox16.SetFocus End Sub Private Sub TextBox16_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim m As Long If IsNumeric(TextBox16.Value) Then With ThisWorkbook.Worksheets(1) If .Cells(1, col).Value = "" Then .Cells(1, col).Value = Label29.Caption m = .Cells(Rows.Count, col).End(xlUp).Row + 1 .Cells(m, col).Value = TextBox16.Value End With End If With TextBox16 ListBox3.AddItem .Value .Value = Empty TextBox15.Value = ListBox3.ListCount Cancel = True End With End Sub

اريد كود عمل كشف حساب لهذه البيانات كما موضح ولكم جزيل الشكر New ورقة عمل Microsoft Excel (2).xlsx

السلام عليكم ورحمة الله جرب هذا الملف الرقم _القومى.xlsm

اهم شي استاذ حكمت ان تتعرف على الخطأ .. وليس ان تتجاوزه

سلمكم الله من كل سوء

نجح الأمر 100 % تسلم

اعمل ضغط و اصلاح

وعليكم السلام 🙂 اذا فهمت قصدك: في بداية الكود عندك كود هكذا مثلا (اخذته من احد برامجي 🙂 ) : نستعمل On Error Goto err_Form_Close في البداية ، بحيث اي خطأ يحدث في الكود سيذهب الى السطر :err_Form_Close من مكان هناك ، بدل الامر Goto ، نستعمل الامر Resume فبدل عن Goto Exit_Form_Close ، نستعمل Resume Exit_Form_Close Private Sub Form_Close() On Error GoTo err_Form_Close ..... Exit_Form_Close: Exit Sub err_Form_Close: If Err.Number = 2450 Then 'ignor Resume Next 'تخطى هذا الخطأ وانتقل الى السطر التالي ElseIf Err.Number = 52 Then 'Folders don't exist, its a new location, ignor Exit Sub 'اخرج من الحدث ElseIf Err.Number = 76 Then 'path not found MsgBox "مسار مجلد النسخ الاحتياطية غير موجود على حاسبتك" Resume Exit_Form_Close ' Exit_Form_Close اذهب الى السطر Else MsgBox Err.Number & vbCrLf & Err.Description End If Resume Exit_Form_Close End Sub جعفر

اعمل استعلام جديد وفى الاستعلام افتح وضع ال SQL فى طريقة العرض وفيها احذف المكتوب كله وضيف الكود ده SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Flags)=0) AND ((MSysObjects.Type)=-32768)); واحفظ وكل سنه وانت طيب وبيها طبعا ممكن لو غيرت المعيار من -32768 الى 5 هيظهر لك الاستعلامات فقط

في هذه الحالة نستبدل كلمة mas بمرجع الخلية المطلوبة أمر التصدير .Export Filename:=ThisWorkbook.Path & "\mas.jpg", Filtername:="JPG" يتم تغييره إلى .Export Filename:=ThisWorkbook.Path & "\" & [b3] & ".jpg", Filtername:="JPG" بالتوفيق

اعتذر - صحيح .. ممكن طلب .. حفظ الصورة على اساس الاسم الذي هو موجود في خلية B3

يبدو أن حضرتك ما لاحظت هذا الجزء Filename:=ThisWorkbook.Path & "\mas.jpg" وهو يعني في نفس مسار المصنف باسم mas. jpg

السلام عليكم اين يتم حفظ الصورة؟

ههههه انا عملته في التقرير

Sub Test() Dim ws As Worksheet, sh As Worksheet, m As Long Application.ScreenUpdating = False Set ws = Sheet1 Set sh = Sheet5 m = ws.Cells(Rows.Count, 2).End(xlUp).Row ws.Range("A3:H" & m).Copy sh.Range("A3").PasteSpecial xlPasteValues Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

جزاك الله كل خير وربنا يجعله في ميزان حسناتك

No way without using VBA

استخدم الكود التالي ActiveSheet.PageSetup.CenterHeader = Format(Date, "yyyy-mm-dd") ActiveSheet.PrintPreview

انظر الاستعلام وطبق ماتريد بها ..... TEST_OD.accdb

Private Sub TextBox16_Exit(ByVal Cancel As MSForms.ReturnBoolean) Const col As Long = 6 Dim m As Long If IsNumeric(TextBox16.Value) Then With ThisWorkbook.Worksheets(1) If .Cells(1, col).Value = "" Then .Cells(1, col).Value = Label29.Caption m = .Cells(Rows.Count, col).End(xlUp).Row + 1 .Cells(m, col).Value = TextBox16.Value End With End If With TextBox16 ListBox3.AddItem .Value .Value = Empty Cancel = True End With End Sub

السلام عليكم 🙂 لإصطياد الخطاء في النموذج: جعفر

اعتقد ان حقل الكمية هو السبب.. لان المفروض في حدث تغيير رقم الباركود تدخل الكمية (1)

الكود فعلا يحدد نطاق البحث في بداية الاسم للوصول لما تريد غير هذا السطر في حدث عند تغيير مربع النص10 If C Like TextBox10.Value & "*" Then إلى If C Like "*" & TextBox10.Value & "*" Then بالتوفيق

يمكنك استعمال هذه الأكواد في النموذج Private Sub ComboBox1_Change() Sheet1.Range("a1").CurrentRegion.AutoFilter Field:=4, Criteria1:=ComboBox1.Value End Sub Private Sub ComboBox2_Change() Sheet1.Range("a1").CurrentRegion.AutoFilter Field:=5, Criteria1:=ComboBox2.Value End Sub Private Sub ComboBox3_Change() Sheet1.Range("a1").CurrentRegion.AutoFilter Field:=6, Criteria1:=ComboBox3.Value End Sub Private Sub CommandButton1_Click() ComboBox1.Value = "" ComboBox2.Value = "" ComboBox3.Value = "" Sheet1.Range("a1").CurrentRegion.AutoFilter End Sub Private Sub UserForm_Initialize() Me.ComboBox1.List = Array("معلم", "مهندس", "فني", "مدير", "مهندس اقدم", "محامي") For n = 1 To 12 Me.ComboBox2.AddItem n Next n For n = 2003 To 2022 Me.ComboBox3.AddItem n Next n End Sub لاحظ طرق تعبئة combobox واستعمال currentregion بالتوفيق

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

وعلشان يكتمل الموضوع ، ومن ارشيفي ، ولا اعرف من عمل هذه البرامج ، اليك مرفقين: 1. تحديد عدد السجلات في التقرير ، 2. تحديد عدد السجلات في النموذج المستمر ، جعفر عدد السجلات للنموذج المستمر v.2.mdb تحديد عدد السجلات في التقرير.mdb

حسن البدوي أين انت من هذه الإجابة الممتازة؟!!! لم أرى اى ضغط على الإعجاب من طرفك , وهل جزاء الإحسان الا الإحسان ؟!!!! أين الضغط على الإعــــجـــــاب , وكما اتفقنا ان هذا أقل ما يقدم لمن له الفضل عليك بعد ربنا فى حل مشكلتك وتفريج كربتك ؟!!! 💙

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

تم تعديل مرفقات المشاركة الأولى وإضافة ساعة عقارب وتعديل الكود وتطويره بصورة أكثر احترافية أخي الكريم عبده أحمد الكود يوضع في موديول جديد ويوجد في الكود الخلية التي تظهر فيها الساعة range("d1") غيرها إلى range("a1")

وإياكم أستاذ عماد وفقنا الله جميعا للخير

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

تفضل الدالات الخاصة ببرنامج الآكسس.rar

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

بالفعل هي نسخة تجريبية وليست نهائية ولعلك لاحظت أن حدود إكسل 2010 عادت إلى ما كانت عليه في إكسل 2003 256 عمود فقط في مقابل 65000 تقريبا في إكسل 2007 و56000 صف تقريبا في مقابل 1048000 صف تقريبا في إكسل 2007 وأنا شخصيا استعملته فترة للتجربة ثم عدت لنسخة 2007 حتى يتم صدور النسخة النهائية من اوفيس 2010 كل عام أنتم بخير

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

رأيك شهادة أعتز بها أخي خبور وهذا دليل وصول الرسالة لاحظ اسم المرسل وبريده وعنوان الرسالة وتنسيق الرسالة كصفحة html وأهم شيء إذا لم تظهر حروف الرسالة بحروف عربية يجب تغيير الترميز إلى arabic(windows-1256) كما هو موضح بالصورة كل عام أنتم بخير

أخي الكريم أبا مشاري بعيدا عن استخدام برنامج أوتلوك المتخصص في إرسال البريد والذي يحتاج إلى نوعمعين من حسابات البريد التي تدعم البوب أب جئت لك بكود إرسال بريد مباشرة بدون برامج اعتمادا على حسابك في gmail فإذا لم يكن لديك حساب فيجب التسجيل في www.gmail.com ينبغي بعض المعرفة بطريقة كتابة صفحات html إذ كنت ترغب في رسالة ذات مستوى عالٍ لكتابة أكواد صفحة test.html وأتركك مع المرفق وأي استفسار لا تتردد mas_mailer.rar

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

طبعا مشكورين ولكن لي اقتراح على أي أساس يكون التلوين؟ ونستعمل sumif بمعنى أننا نلون مثلا القيم أكبر من 100 مثلا نستعمل الدالة sumif بنفس الشرط والله أعلم

أشكر جميع الإخوة على المرور وخاصة أخي خالد القدس ولكن هذه النسخة بيتا أو تكنيكال بريفيو بعنب نسخة تجريبية لمعرفة عيوبها وتلافيها في الإصدار النهائي الذي لم يصدر بعد وفور صدوره سآتي به إليكم إن شاء الله

أختنا و معلمتنا الكريمة الغالية علينا جميعاً زهرة جزاك الله كل خير أخي الكريم رضوان