View Full Version : [SOLVED:] Saving Selection Ranges on difrant sheets as One PDF
mokhtar
06-23-2015, 05:07 PM
Hi everyone,
I have an excel file with 4 sheet
sheet1.range "A1" = "PRINTING"
sheet1.range "A5" = "MOKHTAR"
sheet1.range "D5" = 2015
sheet4.range "A1" = "PRINTING"
I'm trying to create a code to do this :
1- Select Worksheet.RANGE A1:F20 If Worksheet.Range("A1") = "PRINTING"
2- SAVE SELECTION RANGES AS ONE PDF FILE
PDF Name:="D:\" & Worksheets(1).Range("A5").Value & " " & Worksheets(1).Range(" D5 ").Value
Regards
Kenneth Hobs
06-23-2015, 06:26 PM
In this case, there would be 2 PDF pages?
For your PDF name, you will need to concatenate ".pdf".
mokhtar
06-24-2015, 02:30 AM
Thank you so much mr kenneth for the response
but there is a solution to create one pdf from selection ranges
I'll try this solution : copy selection ranges - add new sheet - paste - create one pdf from new sheet -delete new sheet
Could you help me to do this task please any suggestions are welcome
Thanks in advance for your help!!
mokhtar
06-24-2015, 05:57 AM
HI mr kenneth
this is my solution to create one pdf from selection ranges on different sheets
Sub SaveAsPDFB2CON()
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
but the data in sheet RESULT repeated 2 times
how i prevent this repeat
sorry for my bad english.
Regards
Kenneth Hobs
06-24-2015, 08:01 AM
Your English is better than my anything other than English.
You are close. I would do this for you if needed but you seem to nearly have it anyway. I would use a few of the concepts that I used in the recent link below. You will notice that one seldom needs Select or Activate.
http://www.vbaexpress.com/forum/showthread.php?52996-Saving-Excel-Selection-as-A-PDF-document
If you need me to add those concepts to yours, just let me know. You learn more by doing it yourself though. If you get it working, please post your final code.
mokhtar
06-24-2015, 04:14 PM
mr kenneth you're really wonderful , Thanks for your time
the link is very useful , but I have tried several ways and get the same problem
Could you do this for me Just update my code to works exactly as i hoped
without any problem or repitition the data
Thanks in advance
mokhtar
Kenneth Hobs
06-24-2015, 04:51 PM
I normally test code before posting but did not in this case. Try it out and if you can't see how to fix a problem, just post back. Always test code on a backup copy.
You will note that I used Debug.Print. This method can help you debug code when you view the output in the Immediate Window of the Visual Basic Editor (VBE).
Sub SaveAsPDFB2CON()
Dim fName As String, i As Integer, ws As Worksheet
Dim cWS As Worksheet, rWS As Worksheet
On Error GoTo EndSub
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set cWS = ActiveSheet
fName = "D:\" & Worksheets(1).Range("A5").Value2 & " " & Worksheets(1).Range("D5").Value2 & ".pdf"
Debug.Print fName, Len(Dir(fName)) <> 0
Set rWS = Worksheets.Add(After:=Sheets(Worksheets.Count))
rWS.Name = "RESULT"
For Each ws In Worksheets
With ws
If .Name <> "RESULT" Then
If LCase(.Range("A1").Value2) = "printing" Then _
.Range("A1:F20").Copy rWS.Range("A" & rWS.Rows.Count).End(xlUp).Offset(1)
End If
End With
Next ws
rWS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
rWS.Delete
cWS.Activate
EndSub:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
mokhtar
06-24-2015, 05:12 PM
Oh yeah
mr kenneth you're really fantastic
Thank you so much ... it works exactly as i hoped
Million Thanks
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.