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

طبعا نفس الحال .. وبعض الأحيان أقول ربما يستخدم ترجمة آلية إلى اللغة العربية لهذا السبب يكون أغلب الكلام غير مفهوم ومركب بشكل خاطئ إضافة إلى أن أغلب الملفات عن تنزيلها لا تعمل لدي! عموما الشكر لـ hanan_ms على جهوده ومحاولاته.

هل الصور باسم رقم جلوس الطالب ام بأسماء اخرى

أقرت المملكة العربية السعودية منذ أيام قليلة رمزاً جديداً للريال السعودي، في هذا المقطع 3 طرق تشرح كتابة رمز الريال السعودي وإدراجه في برنامج اكسل، سواء إدراجه كصورة أو كحرف (رمز) من لوحة المفاتيح.

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

ما شاء الله عليك ،، ابدعت بتحوير الفكرة للمطلوب الذي تريده . بهذا تستطيع اغلاق الموضوع باختيار أفضل إجابة 😇 .

السلام عليكم ورحمة الله وبركاته أستاذ الفاضل @algammal علمناك دائما واسع الصدر طويل البال ولا يختلف أحد على عزة نفس الجميع في هذا الصرح وحضرتك أولهم وكلنا يتواصل مع الأصدقاء في هذا الصرح بروحه لأننا ربما لا نعرف بعضنا معرفة شخصية في الواقع ولذا نلتمس لبعضنا العذر في اختلاف الثقافات والبيئات فلا أعتقد أن الصديق الذي ارسل لحضرتك هذه الرسالة يقصد الإساءة لحضرتك ولكنه يقصد فقط أن نتعاون جميعا ويدعم بعضنا بعضا ونكون سببا في الارتقاء بأنفسنا واعذرني في تحليلي لنص الرسالة بطريقة مختلفة: الأخ صاحب الرسالة يريدك فقط أن تدعم من قام بالإجابة بالضغط على زر الإعجاب وزر أفضل إجابة (وهذه نواحي تنظيمية لمحتوى المنتدى) وهو مما يزيد شعبية من أجاب طلب حضرتك وترتيبه في المنتدى وكل هذا دعما معنويا للمجيب. ومن باب هل جزاء الإحسان إلا الإحسان كلنا ندعم صاحب الرد الجميل بالإعجاب حتى وإن لم يكن أفضل إجابة. وفي الأخير أذكر نفسي وجميع اصدقائي بقول الله تعالى: وَلْيَعْفُوا وَلْيَصْفَحُوا ۗ أَلَا تُحِبُّونَ أَن يَغْفِرَ اللَّهُ لَكُمْ ۗ وَاللَّهُ غَفُورٌ رَّحِيمٌ. جعلنا الله جميعا ممن يحسنون الحديث ويقولون قولا يسلمون فيه من الاثم والأذى وكل عام وأنتم جميعا بخير وصحة وسعادة

تفضل جرب هدا لقد قمت بحدف مربعات النصوص الخاصة بعنوان المدرسة والسنة الدراسية وتعويضها بتنسيق الخلايا مباشرة يمكنك تعديلها بما يناسبك Option Explicit Const tmp As Long = 45 ' <======= ' إرتفاع صف إسم المدرسة Private Const CrWS As String = "النتيجة أ" Private Const sFolder As String = "نتائج التلاميد" ' <=======' إسم مجلد حفظ النتائج Private Const NamePDF As String = "النتائج" ' <=======' PDF إسم الملف المستخرج Private Const Password As String = "119900" ' <======= ' باسوورد الأوراق الخاص بك Sub Copy_SavePDF() On Error GoTo SupError Dim WS As Worksheet, f As Worksheet, Data As Worksheet, OnRng As Range, rng As Range, myRng As Range Dim sPath As String, tempFile As String, arr As Variant, r As Range, Cpt As Long Dim lastRow As Long, i As Long, j As Long, début As Integer, fin As Integer Set f = Sheets(CrWS): Set Data = Sheets("قوائم شهرية أ") If f Is Nothing Or Data Is Nothing Then Exit Sub SetApp False f.Unprotect Password: Data.Unprotect Password f.[A4].Value = 1 Set myRng = Data.Range("C7", Data.Range("C" & Data.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeFormulas, 2) f.[A3].Value = myRng.Cells(myRng.Rows.Count, 1).Offset(0, -2).Value début = f.[A4].Value: fin = f.[A3].Value If Not IsNumeric(f.[A4].Value) Or Not IsNumeric(f.[A3].Value) Or début < 1 Or fin < 1 Or début > fin Then GoTo EndSub If MsgBox("هل ترغب بحفظ النتائج من " & début & " إلى " & fin & "؟", vbYesNo + vbExclamation, "تأكيد") = vbNo Then GoTo EndSub Set OnRng = f.Range("B7:P35") On Error Resume Next Set WS = Sheets("PDF") On Error GoTo SupError If WS Is Nothing Then Set WS = Sheets.Add: WS.Name = "PDF": WS.DisplayRightToLeft = True tempFile = ThisWorkbook.Path & "\" & sFolder If Dir(tempFile, vbDirectory) = "" Then MkDir tempFile For i = début To fin Step 2 f.[A4].Value = i lastRow = WS.Cells(WS.Rows.Count, "B").End(xlUp).Row Set rng = WS.Range("B" & IIf(IsEmpty(WS.[B3].Value), lastRow + 1, lastRow + 5)) OnRng.Copy With rng .PasteSpecial xlPasteValues: .PasteSpecial xlPasteFormats: .PasteSpecial xlPasteColumnWidths End With WS.HPageBreaks.Add Before:=WS.Cells(rng.Row + OnRng.Rows.Count, 1) Application.CutCopyMode = False Cpt = rng.Row Do While Cpt <= rng.Row + OnRng.Rows.Count - 1 If Not IsEmpty(WS.Cells(Cpt, 2).Value) Then WS.Rows(Cpt).rowHeight = tmp End If Cpt = Cpt + 15 Loop Next i lastRow = WS.Range("B:P").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Set r = WS.Range("B1:P" & lastRow) arr = r.Value For i = 1 To UBound(arr, 1) For j = 1 To UBound(arr, 2) If arr(i, j) = 0 Then arr(i, j) = "" Next j Next i r.Value = arr For i = 4 To lastRow If Trim(WS.Cells(i, 2).Value) = "اسم التلميذ/" And _ (WS.Cells(i, 14).Value = "" Or Not IsNumeric(WS.Cells(i, 14).Value)) Then WS.Rows(i).Hidden = True If i + 1 <= lastRow Then WS.Rows(i + 1).Hidden = True: If i - 1 >= 4 Then WS.Rows(i - 1).Hidden = True For j = i + 2 To lastRow WS.Rows(j).Hidden = True Next j Exit For End If Next i sPath = tempFile & "\" & NamePDF & ".pdf" With WS.PageSetup lastRow = WS.Range("B:P").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row .Orientation = xlPortrait: .Zoom = False: .FitToPagesWide = 1: .FitToPagesTall = False .TopMargin = Application.InchesToPoints(0.5): .BottomMargin = Application.InchesToPoints(0.5) .LeftMargin = Application.InchesToPoints(0.2): .RightMargin = Application.InchesToPoints(0.2) .CenterHorizontally = True: .PrintArea = "B1:P" & lastRow End With WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False f.[A4].Value = 1: WS.Delete MsgBox "تم حفظ جميع نتائج الطلاب بنجاح", vbInformation EndSub: f.Protect Password: Data.Protect Password SetApp True Exit Sub SupError: Resume EndSub End Sub Private Sub SetApp(ByVal enable As Boolean) On Error Resume Next Application.ScreenUpdating = enable Application.EnableEvents = enable Application.DisplayAlerts = enable End Sub النتائج.pdf كنترول-صف-سادس-أ-ب سجل وسطي v2.xlsm

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة طلب تسجيل اكبر عدد من الفواتير المرحلة و الحفاظ عليها تم ارفاق كود الحل من الفاضل _ أ /طلعت محمد حسن و لا تنسونا من صالح الدعاء تحياتى تصميم فاتورة (1).rar