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

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

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Private Const sFolder As String = "ملفات PDF" Private Const CrWS As String = "لجان 4" Sub SavePDF() Dim f As Worksheet, début As Integer, fin As Integer, i As Integer Dim sPath As String, sName As String, tempFile As String Set f = Sheets(CrWS) If Not IsNumeric(f.[B1].Value) Or Not IsNumeric(f.[S2].Value) Then Exit Sub début = f.[B1].Value: fin = f.[S2].Value If début < 1 Or fin < 1 Or début > fin Then Exit Sub If MsgBox("هل ترغب بحفظ الصفحات من " & début & " إلى " & fin & "؟", vbYesNo + vbExclamation, "تأكيـــد") = vbNo Then Exit Sub Application.ScreenUpdating = False tempFile = ThisWorkbook.Path & "\" & sFolder If Dir(tempFile, vbDirectory) = "" Then MkDir tempFile For i = début To fin Step 2 f.[B1].Value = i sName = f.[F7].Value & IIf(f.[M7].Value <> "", " - " & f.[M7].Value, "") sPath = tempFile & "\" & "Page - " & sName & ".pdf" On Error Resume Next f.ExportAsFixedFormat Type:=xlTypePDF, fileName:=sPath, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False On Error GoTo 0 Next i Application.ScreenUpdating = True MsgBox "تم حفظ الملفات بنجاح", vbInformation End Sub المصنف v2.xlsb

1) للأسف طريقة إشتغالك على الملف لن تمكنك من حفظ جميع الملفات على ملف واحد PDF لاكن هناك حلول بديلة وهي إما دمجها يدويا من خلال برامج خارجية بعد الحفظ أو محاولة إظافة ورقة جديدة يتم نسخ الصفحات المطلوبة إليها تحت بعضها البعض وبالتالي تنسيق وحفظ الورقة في ملف مستقل وهدا يتطلب تعديل كود و طريقة الحفظ 2) مكان الحفظ الحالي هو مجلد في نفس مسار المصنف بإسم ملفات PDF 3) مسألة إرجاع قيمة الخلية F7 بعد الحفظ الى 1 يكفي في أخر الكود وضع f.[B1].Value = 1

أعتقد أن طلبك الأخير يختلف عما دكرت سابقا الطلب رقم 2 المطلوب عند اختيار من الكومبوبكس اي من الخلايا العمود b يقوم بمسح الصف باكمله فعندما تكون الخليه فارغة لا تظهر في الكومبوبكس لمسح الصف وكذلك عند اختيار خلية تحتوى على رقم لا يمسح الصف جرب هل هدا ما تقصده Private Sub CommandButton1_Click() Dim lastRow As Long, ky As String, c As Range If Me.ComboBox1.Value <> "" Then If Not CrWS Is Nothing Then lastRow = CrWS.Cells(CrWS.Rows.Count, "B").End(xlUp).Row If lastRow < 2 Then Exit Sub Application.ScreenUpdating = False For Each c In CrWS.Range("B2:B" & lastRow) If c.Value = Me.ComboBox1.Value Then If Not IsNumeric(c.Value) And c.Value <> "" Then c.EntireRow.Delete End If End If Next c Application.ScreenUpdating = True UserForm_Initialize End If End If End Sub في حالة الرغبة لعدم إظهار القيم الرقمية والفارغة على الكومبوبوكس يمكنك تعديل كود جلب البيانات على الشكل التالي Private Sub UserForm_Initialize() Dim Tbl As Object, c As Range, temp As Variant, lastRow As Long Set Tbl = CreateObject("Scripting.Dictionary") If Not CrWS Is Nothing Then lastRow = CrWS.Cells(CrWS.Rows.Count, "B").End(xlUp).Row If lastRow > 1 Then For Each c In CrWS.Range("B2:B" & lastRow) If Not IsNumeric(c.Value) And c.Value <> "" Then Tbl.Item(c.Value) = c.Value End If Next c End If If Tbl.Count > 0 Then temp = Tbl.Items Me.ComboBox1.List = temp End If Else MsgBox "المصنف أو الورقة المحددة غير موجودة", vbExclamation End If End Sub TEST 2.rar

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

استاذ @ابو عارف شكراً جزيلاً افدتني جداً

السلام عليكم ورحمة الله تعالى وبركاته اليكم هديه اخرى ولكن الحق أحق أن يتبع كل الشكر و التقدير لاستاذى الجليل ومعلمى القدير و اخى الحبيب الاستاذ @Foksh على موضوع : ⭐ هدية ~ تغيير لغة النظام في Unicode⭐ قمت بعمل تحديثات جذرية فى هيكل وبناء الكود المميزات : عدم الاعتماد على وسيط بانشاء ملف فى مسار محدد لتمرير اومر الاعدادات ثم حذفه بعد تمرريرها وتطبيقها اضافة نموذج جديد للتحكم فى اختيار وتنسيق الوقت والتاريخ بشكل فورى امكانيه اضافة تخطيط لوحات مفاتيح للغات مختلفة حسب الحاجة والرغبه امكانية حذف تخطيط لغة/لغات لوحات مفاتيح من مربع القيم باختيار مفرد او متعدد لاكثر من لغة التخلص من تخطيطات لوحات المفاتيح المزعجة وحذفها بسهوله و التى قد تصادف العديد عند استخدام قواعد بيانات تعديل التنسيق للوقت والتاريخ او اضافة تخطيط لغة مفاتيح او حذفها لا يتطلب اعادة التشغيل مطلقا امكانية نقل النماذج لاى قاعدة للعمل فورا بدون اى تعديلات تذكر واخيـــــــــــــر المرفق اتمنى لكم تجربة ممتعة LanguageCheck V3.0.1.accdb

تفضل أخي test (3).accdb

مشاركة مع استاذي العزيز @ابو جودي..اللي ليه وحشة كبيرة في الموقع بحث بالرقم او الحرف داخل الكمبوبوكس cboSearch.rar

للاسف عرفت ذلك متاخر فالان قاعدة البيانات كبيرة لا استطيع التعديل عليها الان