Mon Light قام بنشر فبراير 24 قام بنشر فبراير 24 السلام عليكم لو سمحتم الشيت دة فية تموذج شهادة لطالبين بتاخد البيانات من شيت 6 وفية زر بيطبع الشهادات زى ما بحدد فى الخليتين الى لونهم اصغر بس بيطبعهم طباعة مباشرة صفحة ورا صقحة زى ما بحدد فى الخليتين الصفرا لو انا محتاج مثلا احدد من صفخة 1 الى صفحة 12 او اى غدد بناء على عدد الطلبة الى عندى فى شبت النتيجة مثلا 12طالب على 2 طالب فى الورقة هكتب من 1 الى 6 بس كنت عايز كود يحولهم PDF بدل الطباعة المباشرة يعنى 6 صفحات ولو عدد اكبر نفس الوضع يحولهم ايا كان عدد الصفحات وشكرا 666.xlsm
Mon Light قام بنشر فبراير 24 الكاتب قام بنشر فبراير 24 ملحوظة يعتى يخول 6 صفحات PDF ولو العدد اكبر برضة يحولهم PDF
أبومروان قام بنشر فبراير 24 قام بنشر فبراير 24 وعليكم السلام جرب الكود التالي لعله يفيد حضرتك ولعله المطلوب Sub Export_PDF() Dim SH As Worksheet, R As Range, File_name As String Set SH = ThisWorkbook.Worksheets("Sheet3 (2)") File_name = SH.Range("p8").Value Set R = SH.Range("A1:x35") R.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & File_name End Sub 6666.xlsm 118.pdf 2
Mon Light قام بنشر فبراير 24 الكاتب قام بنشر فبراير 24 انا جربت الكود اولا متشكر لحضرتك بس هما اكتر من صفحة لو لاحظت حضرتك لما تضغط على الزر بيغير القيمة الى فى الخلية AF بيزودها 2 وبطيطبع الورقة ويزود 2 ويطبع ورقة تانى لحد ما يوصل للعدد المحدد فى الخلية AC12 يعنى لو اكتر هيفضل يطبع لحد ما يوصل العددالكود دة حول اخر صفحة ل PDF انا كنت محتاجة يحول كل الصفحات الى بتتطبع لملف PDF
أفضل إجابة محمد هشام. قام بنشر فبراير 24 أفضل إجابة قام بنشر فبراير 24 (معدل) للتوضيح : لاسخراج جميع الاوراق في ملف PDF واحد يتضمن جميع الطلاب ربما يتعين عليك مثلا نسخ جميع الاوراق المطبوعة لورقة اخرى اسفل بعضها البعض لتتمكن من حفظها بعد دالك . وهدا يتطلب اظافة ورقة جديدة للمصنف مع انشاء الكود الخاص بدالك . اما في حالة الرغبة في حفظها مستقلة اليك الكود التالي سيقوم بحفظ كل ورقة لوحدها في مجلد باسم شهادات الطلاب بعد تسمية كل ملف باسم الطالب الخاص به Private Sub CommandButton1_Click() Dim i As Integer, fPath As String, F As String Dim WS As Worksheet: Set WS = Sheet31 'Sheets("Sheet3 (2)") ' اسم ورقة العمل Application.ScreenUpdating = False For i = [AA12] To [AC12] If i <= [AA1] Then [AF2] = 2 * (i - 2) + 3 F = [B8] ' اسم الملف On Error Resume Next With ActiveWorkbook ' قم بتعديل اسم المجلد بما يناسبك fPath = .Path & Application.PathSeparator & "شهادات الطلاب" & Application.PathSeparator If Len(Dir(fPath, vbDirectory)) = 0 Then End If MkDir fPath WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & "\" & F & ".pdf", OpenAfterPublish:=False 'طباعة 'WS.PrintOut End With Next i Application.ScreenUpdating = True End Sub 666 PDF.xlsm تم تعديل فبراير 24 بواسطه محمد هشام. 4 1
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.