كود PDF بشرطين

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

السلام عليكم

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

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

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

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

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

بشرطين

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

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

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

مرفق الملف

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

PDF.rar

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

السلام عليكم

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

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

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

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

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

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

مرفق الملف

 

PDF.rar

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

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

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

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

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

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

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

Next SH

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

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

End If

وكذلك جملة With

End With

تقبل تحياتي

[Yasser Fathi Albanna]

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

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

كنا مفتقدينك

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

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

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

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

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

للرفع

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

السلام عليكم 

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

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

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

السلام عليكم

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

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

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

مرفق ملف PDF

 

ahmed 5.rar

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

للرفع

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

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 بواسطه مختار حسين محمود

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

السلام عليكم

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

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

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

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

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

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

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

 

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

 

 

 

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

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

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

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

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

 

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

 

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

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

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

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

السلام عليكم

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

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

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

أخى أبو حنين 

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

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

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

الفكرة  هى عمل شيت جديد  نلصق فيه النطاقات التى تحوى كلمة  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  فقط  لكن النطاقات تكررت مرتين . وسوف أحاول منع ذلك فى الوقت القريب بإذن الله

 

تفضل المرفق

PDFBased 2 Condition Version 2 .rar

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

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

الكود ينتج عنه ملف 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

تفضل المرفق

PDF Based 2 Condition Final .rar

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

السلام عليكم

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

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

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

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

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

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

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

[Yasser Fathi Albanna]

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

الكود ينتج عنه ملف 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

تفضل المرفق

 

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

الكود ينتج عنه ملف 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

تفضل المرفق

 

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

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

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

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