كود PDF بشرطين

**۩◊۩ أبو حنين ۩◊۩** · يونيو 19, 2015

السلام عليكم

اولا.... رمضان الخير لجميع المسلمين

اسال الله ان يجعل رمضان بدايه خير لكل المسلمين

بدايه للقربة الى الله والعمل بما يرضيه

الاخوة الكرام

هلى يمكن عمل كود حفظ pdf

بشرطين

1- يتم حفظ الملف باسم ..... الاسم بدلالة خليتين A5 +D5 فى المسمى 1

حيث ان A5 اسم متغير على اساس معادلات و D5 هو رقم متغير ايضا وهو تسلسل

2- ان يقوم بحفظ الشيتات التى محتوى الخليه A1 (printing ) ليس اكثر

مرفق الملف

جزاكم الله كل الخير

PDF.rar

**۩◊۩ أبو حنين ۩◊۩** · يونيو 19, 2015

السلام عليكم

الاخوة الكرام

لقد وجت كود لاخوة

مختار حسين والاخ ياسر خليل

وتم الحفظ فعلا بدلالة الخليتين

ويبقى الطلب الثانى

2- ان يقوم بحفظ الشيتات التى محتوى الخليه A1 فيها كلمه ( printing )

مرفق الملف

PDF.rar

**۩◊۩ أبو حنين ۩◊۩** · يونيو 19, 2015

ارجو المساعده فى معرفة مكمن الخطاء فى كود

AHM_PDF

حيث انه يقوم بحفظ الملف بصيغه PDF ويتم اختيار الشيتات التى محتوى الخلية A1 كلمة printing

اقتباس هذا الكود من كود طباعه حيث يقوم بطباعه بشرط

If sama = vbYes Then
For Each Sh In Worksheets
If Sh.[A1] = "printing" Then Sh.PrintOut Copies:=1

جزاكم الله خيرا

PDF1.rar

ياسر خليل أبو البراء · يونيو 19, 2015

أخي الكريم أبو حنين

لا أستطيع العمل على الملف ولكن إليك بعض التوجيهات

لا تنسى القفلات ..يعني جملة التكرار لاحظت أنها غير مكتملة لابد من الجملة

Next SH

وكذلك جملة الشرط If

لابد من القفلة

End If

وكذلك جملة With

End With

تقبل تحياتي

**Yasser Fathi Albanna** · يونيو 19, 2015

حمدا لله على سلامتك يا حبيبى أ / ياسر خليل

كل سنة وحضرتك بخير ويعود عليك الأيام بخير

كنا مفتقدينك

**۩◊۩ أبو حنين ۩◊۩** · يونيو 19, 2015

اولا جزاك الله كل الخير اخى الحبيب ياسر ..

على التوجيهات والملاحظات

ولاكنى مع الاسف لم اصل للحل الصحيح

**۩◊۩ أبو حنين ۩◊۩** · يونيو 20, 2015

للرفع

**عبدالله المجرب** · يونيو 20, 2015

السلام عليكم

Sub SHEET_SaveAsPDF()
 Dim fName As String, i As Integer
  For i = 1 To Sheets.Count
 With Worksheets(i)
 If .Range("A1") = "printing" Then
 fName = .Range("A5").Value & " " & .Range(" D5 ").Value
If .Range("A5").Value = "" And .Range("A5").Value = "" Then GoTo 1
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
            "D:\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
 End If
 End With
1  Next
End Sub

جرب هذا التعديل

**۩◊۩ أبو حنين ۩◊۩** · يونيو 20, 2015

السلام عليكم

الاخ الكريم عبد الله

رمشانطريم عليك وعلى جميع المسلمين

اخى الحبيب تم تجربه الكود والملف الزى تم تحويله الى PDF به صفحه واحده على الرغم من وجود شيتات الخلية A1 بها كلمة printing

مرفق ملف PDF

ahmed 5.rar

**۩◊۩ أبو حنين ۩◊۩** · يونيو 22, 2015

للرفع

**مختار حسين محمود** · يونيو 23, 2015

Sub SaveAsPDFB2CON()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  
  Dim fName As String
  Dim i As Integer
 
  For i = 1 To Sheets.Count
  
       With Worksheets(i)
       fName = Worksheets(i).Range("A5").Value & " " & Worksheets(i).Range(" D5 ").Value
       If Worksheets(i).Range("A1") = "printing" Then
       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="D:\" & fName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
       End If
       End With
 Next i
 
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
End Sub

أخى بو حنين كل ورقة اكسل يوجد فيها كلمة printing فى الخلية A1 يتم حفظها بصيغة PDF باسم مكون من الخليتين A5 ,D5

لابد من وجود الشرطين الأول : كلمة printing فى الخلية A1 الثانى : بيانات فى الخليتين A5 ,D5

ملحوظة : كود الأستاذ عبدالله يعمل بكفاءة يبدو أنك أخطأت فى التطبيق .

تحياتى للجميع

PDF22222.rar

تم تعديل يونيو 23, 2015 بواسطه مختار حسين محمود

**۩◊۩ أبو حنين ۩◊۩** · يونيو 23, 2015

السلام عليكم

الاخ الكريم مختار الاخ الكريم عبد الله

اكيد لم اوضح النطلوب بصوره صحيحه

الاخوة الكرام ...المطلوب

يتم حفظ الملف باسم ..... الاسم بدلالة خليتين A5 +D5 فى شيت (1)

وان يكون الملف مكون من الشيتات التى محتوى الخليه a1 فيها printing

اى لو شيت 1 وشيت 3 و شيت 5 محتوى الخليهA1 فيهما printing

بتم حفظهما فى ملف واحد وان يكون اسم الملف مصدرة ..... A5 +D5 فى شيت (1)

ارجو ان اكون اوضحت المطلوب

تم تعديل يونيو 23, 2015 بواسطه ۩◊۩ أبو حنين ۩◊۩

**مختار حسين محمود** · يونيو 23, 2015

أخى بو حنين أنا فهمت من كلامك أنك تريد pdf واحد

من كل الأوراق التى فيها كلمة printing فى الخلية A1

وهذا الـــ pdf اسمه مكون من الخليتين A5 ,D5 فى الورقة 1 .

اذا كان الأمر كذلك فقد حاولت التعديل على الكود ونتج pdf واحد ولكن ليس فيه كل الأوراق التى فيها كلمة printing

فيه تكه عايز أجيبها ولكن مش جايه معاى وهى : عايزين نخلى الكود يحدد النطاقات التى بها كلمة printing فى كل الأورارق

ومن ثمّ حفظ النطاقات المحددة بصيغة pdf فى ملف واحد .

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

**۩◊۩ أبو حنين ۩◊۩** · يونيو 24, 2015

السلام عليكم

الاخ الكريم مختار

جزاك الله كل الخير ... وان شاء الله يكون فى حل

**مختار حسين محمود** · يونيو 24, 2015

أخى أبو حنين

فى هذه الحالة اللى أنت طالبها لازم يكون فيه ملفين pdf والمشكلة أنك عايز ملف pdf واحد

طب نعمل ايه فى الكلام ده ؟ّ! اصبر شوية صغيرة فيه فكرة بحاول تطبيقها وهنوصل بإذن الله ...... دعواتك لينا

**مختار حسين محمود** · يونيو 24, 2015

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

هذا هو الكود بعد آخر تعديل توصلت اليه :

Sub SaveAsPDFB2CON333()

  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  
  Dim fName As String
  Dim i As Integer
  Dim ws As Worksheet
  fName = Worksheets(1).Range("A5").Value & " " & Worksheets(1).Range(" D5 ").Value
  
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = "RESULT"
 
  For Each ws In ActiveWorkbook.Worksheets
 
  If ws.Name <> "RESULT" Then
  If ws.Range("A1") = "printing" Then ws.Activate
  ActiveSheet.Range("A1:f20").Copy Destination:=Sheets("RESULT").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  End If

  Next ws
   
  Sheets("RESULT").Activate
  
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="D:\" & fName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
  
 
  Sheets("RESULT").Select
  ActiveWindow.SelectedSheets.Delete
  Sheets("1").Select
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
End Sub

الكود ينتج عنه ملف PDF واحد ويحتوى على النطاقات التى تحوى كلمة printing فقط لكن النطاقات تكررت مرتين . وسوف أحاول منع ذلك فى الوقت القريب بإذن الله

تفضل المرفق :fff:

PDFBased 2 Condition Version 2 .rar

**مختار حسين محمود** · يونيو 25, 2015

أعتقد أن هذا هو الكود النهائى يا أبا حنين

الكود ينتج عنه ملف PDF واحد ويحتوى على النطاقات التى تحوى كلمة printing فقط وبدون تكرار النطاقات

Sub SaveAsPDFB2CONFinal()

    Dim fName As String, i As Integer
    Dim AWS As Worksheet, RWS As Worksheet, ws As Worksheet
      
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
     
    Set AWS = ActiveSheet
    Set RWS = Worksheets.Add(After:=Sheets(Worksheets.Count))
    fName = "D:\" & Worksheets(1).Range("A5").Value & " " & Worksheets(1).Range("D5").Value & ".pdf"
        
    
    For Each ws In Worksheets
       With ws
         If .Range("A1").Value = "printing" Then .Range("A1:F20").Copy RWS.Range("A" & RWS.Rows.Count).End(xlUp).Offset(1)
       End With
    Next ws
        
    RWS.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
    RWS.Delete
    AWS.Activate
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

تفضل المرفق :fff:

PDF Based 2 Condition Final .rar

**۩◊۩ أبو حنين ۩◊۩** · يونيو 25, 2015

السلام عليكم

الاخ الكريم مختار

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

اعجز عن تقدير تعبك ووقتك الثمين انت وجميع اعضاء المنتدى

جزاك الله كل الخير

**مختار حسين محمود** · يونيو 25, 2015

أخى أبا حنين بارك الله فيكم

والحمد لله أننا توصلنا لحل يرضيك كل سنة وحضرتك طيب

**Yasser Fathi Albanna** · يونيو 25, 2015

أعتقد أن هذا هو الكود النهائى يا أبا حنين

الكود ينتج عنه ملف PDF واحد ويحتوى على النطاقات التى تحوى كلمة printing فقط وبدون تكرار النطاقات

Sub SaveAsPDFB2CONFinal()

    Dim fName As String, i As Integer
    Dim AWS As Worksheet, RWS As Worksheet, ws As Worksheet
      
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
     
    Set AWS = ActiveSheet
    Set RWS = Worksheets.Add(After:=Sheets(Worksheets.Count))
    fName = "D:\" & Worksheets(1).Range("A5").Value & " " & Worksheets(1).Range("D5").Value & ".pdf"
        
    
    For Each ws In Worksheets
       With ws
         If .Range("A1").Value = "printing" Then .Range("A1:F20").Copy RWS.Range("A" & RWS.Rows.Count).End(xlUp).Offset(1)
       End With
    Next ws
        
    RWS.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
    RWS.Delete
    AWS.Activate
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

تفضل المرفق :fff:

أعتقد أن هذا هو الكود النهائى يا أبا حنين

الكود ينتج عنه ملف PDF واحد ويحتوى على النطاقات التى تحوى كلمة printing فقط وبدون تكرار النطاقات

Sub SaveAsPDFB2CONFinal()

    Dim fName As String, i As Integer
    Dim AWS As Worksheet, RWS As Worksheet, ws As Worksheet
      
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
     
    Set AWS = ActiveSheet
    Set RWS = Worksheets.Add(After:=Sheets(Worksheets.Count))
    fName = "D:\" & Worksheets(1).Range("A5").Value & " " & Worksheets(1).Range("D5").Value & ".pdf"
        
    
    For Each ws In Worksheets
       With ws
         If .Range("A1").Value = "printing" Then .Range("A1:F20").Copy RWS.Range("A" & RWS.Rows.Count).End(xlUp).Offset(1)
       End With
    Next ws
        
    RWS.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
    RWS.Delete
    AWS.Activate
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

تفضل المرفق :fff:

رائع أخى الحبيب محتار

**مختار حسين محمود** · يونيو 26, 2015

بارك الله فيك أخى ياسر فتحى

علمنى ازاى بتعمل الصور الجميلة دى ازاى بتخلى المشاركة رائعة ؟!! تحياتى

تسجيل الدخول

كود PDF بشرطين

الردود الموصى بها

۩◊۩ أبو حنين ۩◊۩

۩◊۩ أبو حنين ۩◊۩

۩◊۩ أبو حنين ۩◊۩

ياسر خليل أبو البراء

Yasser Fathi Albanna

۩◊۩ أبو حنين ۩◊۩

۩◊۩ أبو حنين ۩◊۩

عبدالله المجرب

۩◊۩ أبو حنين ۩◊۩

۩◊۩ أبو حنين ۩◊۩

مختار حسين محمود

۩◊۩ أبو حنين ۩◊۩

مختار حسين محمود

۩◊۩ أبو حنين ۩◊۩

مختار حسين محمود

مختار حسين محمود

مختار حسين محمود

۩◊۩ أبو حنين ۩◊۩

مختار حسين محمود

Yasser Fathi Albanna

مختار حسين محمود

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information