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

وعليكم السلام -كان عليك ان تقوم بالتالى حدد العمود. اذهب إلى علامة التبويب بيانات (Data) > نص إلى أعمدة (Text to Columns) > إنهاء (Finish) ثم اكتب معادلة جمع عادية وستحصل على النتيجة المرجوة تقرير التأخير الشهري 11112.xlsx

السلام عليكم في كثير من الاوقات ما نعرف نستعمل الفاصلة او الفاصلة المنقوطة !! هي جزء من اعدادات الوندوز في المرفق وحدة نمطية تقوم بجلب الفاصل ، ونستعملها كالتالي: debug.print fList_Seperator او dim fList as string fList=fList_Seperator stDocName = "tbl_student1" & DLookup("Year_name" & fList & "tbl_basic") وانا اقوم بعمل الكثير من ملفات csv ، فحتى الكود يتوافق بين جهازي وبين اجهزة جميع المستخدمين وبغض النظر عن اعدادات الوندوز لهم ، استعمل هذا الكود لحل هذه الحالات Period_or_Semi_Period.zip

يمكن حلها كذلك بالأكواد إذا أردتها تظهر بتنسيق كما الوقت مع أن تنسيق الوقت لا يقبل أكثر من 24 ساعة. تقرير التأخير الشهري_03.xlsx

السلام عليكم ضع المعادلة =SUM(C8:C12) بدل الموجودة في خلية الجمع = SUM(C8+C9+C10+C11+C12) وفي الخلية c6 اكتب المعادلة =EOMONTH(P1;0) خطأ في الجمع و نهاية الشهر.xlsx

تنقيح أخير، أصبح فيه الكود سطر واحد فقط 🙂 Sub Date2Text() Range("B7", "AJ23").NumberFormat = "m-d" End Sub

وعليكم السلام ورحمة الله وبركاته بالنسبة للاوقات التي خارج الاوقات في M&N لم تحدده وفي اي بصمة تسجل تم ربط المعادلات حسب الاوقات في M&N اكسل1.xlsm

تم تنقيح الكود سابقا لو ضغطت الزر أكثر من مرة فسوف يبدل النتائج مع كل ضغطة أما الآن سيبدلها مع الضغطة الأولى فقط. Sub Date2Text() Const sRow = 7, eRow = 23 Const sCol = 2, eCol = 36 Dim Row As Integer, Col As Integer Application.EnableEvents = False Application.ScreenUpdating = False For Row = sRow To eRow For Col = sCol To eCol With Cells(Row, Col) If .NumberFormat = "d-mmm" Then .NumberFormat = "@" If .Value <> "" Then .Value = Month(.Value) & "-" & Day(.Value) End If Else .NumberFormat = "@" End If End With Next Col Next Row Application.EnableEvents = True Application.ScreenUpdating = True MsgBox "Done" End Sub

ممتاز ما قمت به . اكمل ما تريده ل 30 جدول و نشوف النتيجة النهائية بإذن الله

بالأكواد من زر asc2Text_02.xlsm

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

تفضل استاذ @بلال بلال الشرح والمرفق حسب طلبك . ووافني بالرد . Yamen 8-4-2026.rar

وعليكم السلام ورحمة الله وبركاته جرب التعديل بالملف اكسل.xlsm

وعليكم السلام ورحمة الله وبركاته 🙂 تفضل أخي بلالشريط متحرك.mdb

حسب ما فهمت جرب الملف التالي اغلاق الصفوف ذات الرصيد 0 (2).xlsm

اعرض الملف توليد أرقام تلقائية مخصصة (ترقيم تلقائي احترافي) : Auto Increment توليد أرقام مستندات تلقائية مثل أرقام الفواتير والطلبات والسندات (ترقيم تلقائي احترافي) أربع أنماط للترقيم Yearly → INV-2026-000001 : التصفير واعادة الترقيم عند بدء العام الجديد Monthly → INV-2026-04-000001 : التصفير واعادة الترقيم عند بدء الشهر الجديد Daily → INV-2026-04-05-000001 : التصفير واعادة الترقيم عند بدء اليوم الجديد Sequential→ INV-000001 : ترقيم لا نهائى بدون اعادة بدء الترقيم مستمر بلا توقف المزايا : إنشاء تلقائي لجدول التسلسل : tblSequences وظيفته تخزين تسلسل الأرقام الفريد لكل مفتاح (Key) استرداد ذكي عند حذف جدول التسلسل : tblSequences عن طريق الخطأ تم تصميم الكود بحكمة ليعيد إنشاءه تلقائيا ويستأنف الترقيم من آخر رقم موجود في جدول البيانات الأصلي - أى لا انقطاع ولا تكرار أبدا التحكم الأمثل لإضافة بادئة مخصصة أى أنه يمكن عمل أكثر من عملية ترقيم لنفس الحقل حسب النوع, الفرع , المحافظة مثلا .... Cairo-2026-000018 Alex-2026-000001 التحكم فى شكل تنسيق الترقيم للأرقام بطول سلسلة مخصصة من 1 الى 10 مثل : 000001 أو 0000000001 أو حتى آمن في بيئة الشبكة المتعددة المستخدمين: عدم تكرار أي رقم حتى لو فتح عشرة مستخدمين نفس النموذج في نفس اللحظة مع عمل معالجة خاصة لمنع تعارض الطلبات المتزامنة مع حد أقصى للمحاولات لمنع التوقف التام تحت الضغط الشديد صاحب الملف عسل قليل الدسم تمت الاضافه 04/05/26 الاقسام قسم الأكسيس  

حل آخر بالأكواد، في الموضوع السابق فهمتك خطأ بأنك تريد أن يبدأ الشهر دائما مع يوم الأحد وقد تم التعديل في هذه النسخة يتم مراجعة خلية العام الدراسي في حال لم يتم تعديله من قبلكم. حساب_التاريخ_09.xlsm

تفضل اخي الكريم تعديل معادلة.xlsx

اعرض الملف تشفير بيانات في رمز شريطي أو رمز الاستجابة السريعة barcode or Qr-Code Encode input data in a barcode or Qr-Code صاحب الملف عسل قليل الدسم تمت الاضافه 04/04/26 الاقسام قسم الأكسيس  

هههههههه انا قلت يمكن بعدل شي أو يضيف شي داخل الملف للتمييز بينهم 😛 إن شاء الله حال وصولي لنسبة ترضي غرور أفكاري 😁 ، لن أبخل عليكم بها

اليك الملف البحث في القائمة بالحروف.xlsm

للتوضيح هل تقصد الإصدار الذي تم إنشاء التطبيق فيه أم الإصدار الخاص بالمستخدم؟ فمعرفة الإصدار الذي تم إنشاء التطبيق فيه لا أرى أي حاجة إلى معرفته فما الذي سيفرق سواء عرفنا أم لم نعرف إصدار الإنشاء؟

تم مهندسنا الغالي .. ⏳ تم تمديد المدة حتى نهاية شهر 4 إبريل April

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

وأنا كنت أظنها من فرق الإصدارات ، والصوة توضيح لما شككتني به سابقاً معلومتي .. شكراً للتصحيح أخي جعفر

هو احد اعدادات الوندوز :

تفضل التعديل . Yamen-07-04-2026-2.rar

سلام عليكم اخي foksh شكرا على الرد ولكن لم ينفذ ما طلبته اتمنى ان ترى ان كان هناك خطا اخي hegazee اشكرك على الرد الجميل على ما طلبته لكن اريد ان اضيف اليه معلومة في العمل الدي اقوم به يوجد اكثر من جدول حوالي من 20 الى ثلاثين جدول وكل جدول يكون عدد االصفوفه حوالي 20 صف وبين جدول وجدول كذلك عدد من الصفوف اريد لكل جدول زر خاص به لاغلاق صفوفه التي يكون الرصيد يساوي 0 اتمنى ان اجد الجواب كما عملته في الحواب الاول لكن لكل جدول على حدى مرة اخرى اشكرك اخي foksh واخي hegazee على الرد وجزاكم الله خيرا وفي انتظار ردكم تقبلو مني فائق التقدير والاحترام وشكرا والسلام عليكم ورحمة الله تعالى وبركاته اغلاق الصفوف ذات الرصيد 0 (2) (1).xlsm

اعتقد انك هنا تحاول الوصول الى قيمة عنصر موجود في النموذج ، وليس من خلال قيمة حقل داخل جدول. هل جربت كطريقة بسيطة استخدام Dlookup على سبيل المثال stDocName = "tbl_student1" & DLookup("Year_name", "tbl_basic")

جمعت الحلين في مثال واحد واضطررت لحذف كل الأكواد المتعلقة بحل الأستاذ عسل قليل الدسم مع الاعتذار لمزيد من التركيز للسائلة. تجربة صادر_05.accdb

الحمد للة توصلت للكود الاصلى الذى كتبة لى احد الخبراء الافاضل بالمنتدى وقمت بعرضة عليكم لمن يريد الاستفادة منة Sub DuplicateRecords() On Error Resume Next Dim DB As DAO.Database Dim RS As DAO.Recordset Dim newPCode As Long Dim TodayDate As Date Dim JO_Insert_Lab As String Dim JO_Insert_Result As String ' فتح قاعدة البيانات الحالية Set DB = CurrentDb() TodayDate = Format(Date, "mm/dd/yyyy") ' تنسيق التاريخ بالشكل الصحيح ' جلب آخر PCode من جدول Tbl_Lab_All لتجنب التكرار Set RS = DB.OpenRecordset("SELECT MAX(PCode) AS MaxPCode FROM Tbl_Lab_All") If Not RS.EOF Then newPCode = RS!MaxPCode + 1 Else newPCode = 1 ' في حالة عدم وجود سجلات End If RS.close ' استبدال المرجع بالصيغة الصحيحة Dim currentPCode As Long currentPCode = Forms!Laboratory!Lab_Request.Form!PCode ' إدراج السجل الجديد في Tbl_Lab_All JO_Insert_Lab = "INSERT INTO Tbl_Lab_All (DDate, PCode,Code_kind, Pname, Name_Month, C_Year, age,DMY, Doctor,Code_Month, Mon_Year) " & _ "SELECT #" & TodayDate & "#, " & newPCode & ", Code_kind,Pname, Name_Month, C_Year, age,DMY, Doctor,Code_Month, Mon_Year " & _ "FROM Tbl_Lab_All WHERE PCode = " & currentPCode DB.Execute JO_Insert_Lab ' إدراج السجل الجديد في Tbl_Lab_Results JO_Insert_Result = "INSERT INTO Tbl_Lab_Results (PCode, OK) " & _ "SELECT " & newPCode & ", OK " & _ "FROM Tbl_Lab_Results WHERE PCode IN (SELECT PCode FROM Tbl_Lab_All WHERE PCode = " & currentPCode & ")" DB.Execute JO_Insert_Result Me.Requery Me.FilterOn = False DoCmd.GoToRecord , , acLast Me.Esal.SetFocus Me.Esal.Locked = False ' MsgBox " تم تكرار السجل بنجاح مع تحديث كود المريض و تاريخ اليوم ", vbInformation ' Me.FilterOn = False ' DoCmd.GoToRecord , , acLast End Sub Private Sub Duplicate_Click() Select Case MsgBox(" " & " هـل . . . . . تـريـد تكـرار بيــانات الســجل " & vbNewLine & vbCrLf & _ " الخـاص بــ " & PNAME & vbNewLine & vbCrLf & vbCrLf & _ "Yes = كــرر الســجل No = لا تكــرر السجــل ", vbQuestion + vbMsgBoxRight + vbYesNo, JO_Title) Case vbYes DuplicateRecords Case vbNo DoCmd.CancelEvent End Select End Sub

من رخصة الاستاذ منتصر وهذه مشاركة اخرى قد تستفيد منها اخي الكريم 444.accdb

شكرا يا عسل العسل ليس قليل الدسم ... العسل كله حلا

تفضل الملف بعد التعديل HB1.accdb

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

شكراً لك ، ولكني لا أثق بالذكاء الإصطناعي ومقترحاته 😇 .

zint barcode.zip

تم تنقيح الكود لتسهيل التعديل عليه Private Sub Worksheet_Change(ByVal Target As Range) Dim Row As Integer, Col As Integer Dim fRow As Integer, fCol As Integer, fdd As Integer Dim yy As Integer, mm As Integer, dd As Integer Dim cellDate As Date, DateRange As String, m m = Array("", "يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", _ "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") With Target DateRange = Replace(.Address, "$", "") If DateRange <> "M1" Then 'تبديل عنوان خلية التاريخ عند الحاجة' Beep 'MsgBox Exit Sub End If If Not IsDate(Range(DateRange)) Then Beep 'MsgBox Exit Sub End If Application.EnableEvents = False Application.ScreenUpdating = False yy = Year(.Value) mm = Month(.Value) For fdd = 1 To 7 If Weekday(DateSerial(yy, mm, fdd)) = vbSunday Then Exit For Next fdd End With Cells.Find(What:="الأحد", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate fRow = ActiveCell.Row fCol = ActiveCell.Column + 1 Cells(fRow - 2, fCol + 5) = m(mm) dd = fdd - 3 For Col = fCol To fCol + 9 Step 2 dd = dd + 2 For Row = fRow To fRow + 4 dd = dd + 1 cellDate = DateSerial(yy, mm, dd) If Month(cellDate) = mm Then Cells(Row, Col + 0) = cellDate Cells(Row, Col + 1) = 1 Else Cells(Row, Col + 0) = "" Cells(Row, Col + 1) = "" End If Next Row Next Col Application.EnableEvents = True Application.ScreenUpdating = True End Sub حساب_التاريخ_06.xlsm

لو اجريت عملية بحث بسيطة كنت ستجد أكثر من موضوع خاص بـ QRCode وهذا أول موضوع ظهر لي

بارك الله فيك وزدك الله من فضله .. وجعل الله هذا العمل فى ميزان حسناتك ان شاء الله وبالتوفيق والنجاح دائماَ

السلام عليكم جرب التعديل التالي Sub sav_PDFall() Dim i As Integer Dim folderPath As String Dim mainSheet As Worksheet Dim tempWorkbook As Workbook Dim firstRun As Boolean Set mainSheet = ThisWorkbook.ActiveSheet folderPath = ThisWorkbook.Path & "\ملاحظةالثانوية 2026" firstRun = True If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath End If Application.ScreenUpdating = False For i = 1 To mainSheet.Range("j3").Value mainSheet.Range("j2") = i If firstRun Then mainSheet.Copy Set tempWorkbook = ActiveWorkbook firstRun = False Else mainSheet.Copy After:=tempWorkbook.Sheets(tempWorkbook.Sheets.Count) End If Next i tempWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=folderPath & "\كشف_جامع_" & mainSheet.Cells(2, 4).Text & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=True tempWorkbook.Close SaveChanges:=False Application.ScreenUpdating = True End Sub

وعليكم السلام تفضل هذا الملف ربما يفيدك ويكون به المطلوب ان شاء الله وبالتوفيق المحطة.xlsm

السلام عليكم ورحمة الله وبركاته اليك ما طلبت Sub ExportCertificatesToSinglePDF() Dim lr As Long, i As Long, pageCount As Long Dim pdfPath As String, wsMain As Worksheet, tempWS As Worksheet Dim tempSheetNames As Collection Dim sh As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False Set wsMain = ThisWorkbook.Sheets("معلمين") Set tempSheetNames = New Collection wsMain.Range("m2").FormulaR1C1 = "=COUNTA('جدول عام'!R6C1:R22C1)" lr = wsMain.Range("m2").Value i = 1 pageCount = 1 Do Until i > lr wsMain.Range("m2").Value = i wsMain.Copy After:=Sheets(Sheets.Count) Set tempWS = ActiveSheet tempWS.Name = "Temp_" & pageCount tempWS.PageSetup.PrintArea = "$A$1:$i$37" tempSheetNames.Add tempWS.Name i = i + 3 pageCount = pageCount + 1 Loop pdfPath = ThisWorkbook.Path & "\الشهادات.pdf" Dim wsArray() As Variant ReDim wsArray(1 To tempSheetNames.Count) For i = 1 To tempSheetNames.Count wsArray(i) = tempSheetNames(i) Next i ThisWorkbook.Sheets(wsArray).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath For i = 1 To tempSheetNames.Count Application.DisplayAlerts = False ThisWorkbook.Sheets(tempSheetNames(i)).Delete Application.DisplayAlerts = True Next i wsMain.Select wsMain.Range("m2").Value = 1 Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "تم حفظ الشهادات في ملف PDF بنجاح!", vbInformation, "تم الحفظ" End Sub تحويل الشهادات الى pdf.xlsm

أحسنت استاذ مجدى عمل ممتاز جعله الله فى ميزان حسناتك

مبارك الترقية والى الأمام دائماً ومن نجاح الى تفوق ان شاء الله أعانك الله على مهامك الجديدة

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

وعليكم السلام-فقط استخدم هذه المعادلة وشكراً =SUMIF(البيانات!$A$3:$A$140,$A2,البيانات!$D$3:$D$140) العملاء.xlsm

أهلاً وسهلاً بحضرتك فى المنتدى نورتنا وسعداء جداً بوجودك معنا شكراً لكم ونتمنى المزيد من النجاح والتفوق , وياريت رفع مع المشاركة دائما ملف يدعمها لتسهيل الفهم والإستيعاب لجميع الأعضاء

لا يمكن استخدام معادلة subtotoal لعد النصوص بدون فراغات الا بهذه الطريقة =SUBTOTAL(3,$E$1:$E$12)-COUNTBLANK($E$1:$E$12) أو بهذه المعادلة =SUMPRODUCT(SUBTOTAL(3,OFFSET($E$1:$E$12,ROW($E$1:$E$12)-MIN(ROW($E$1:$E$12)),,1))*($E$1:$E$12<>"")) او استخدام هذه المعادلة مباشرة وشكراً وبكده يجب غلق المشاركة =SUMPRODUCT(--(LEN($E$1:$E$12)>0)) خلايا فارغة1.xlsx

تفضل هناك العديد من الأكواد لتنفيذ طلبك منها : Sub PDF_Show() ActiveWorkbook.FollowHyperlink "C:\Users\Ali\Downloads\ÚÞÏ ÇáÊÃÓíÓ-ãÍæá.pdf" 'يجب عليك تغيير وتعديل عنوان ومكان ملف البى دى اف بما يتوافق عندك بين علامتين التنصيص End Sub وهذا كود ثانى Sub OpenPDF() Dim pdf As String On Error Resume Next pdf = "C:\Users\Ali\Downloads\عقد التأسيس-محول.pdf" 'يجب عليك تغيير وتعديل عنوان ومكان ملف البى دى اف بما يتوافق عندك بين علامتين التنصيص ActiveWorkbook.FollowHyperlink pdf End Sub واليك الملف اوراق الشركة.xlsm