I am currently trying to convert a multiple sheet excel file to a PDF using VBA using the following code:
Private Sub CommandButton1_Click()
Dim mySheets As Variant, sh
mySheets = Array("Sheet1", "Sheet2", "Sheet3")
For Each sh In mySheets
Sheets(sh).PageSetup.Orientation = xlLandscape
Next
Sheets(mySheets).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="S:\GasInc\Services\B&ITS\OpsEng\EngServ\_Station Design\Projects\Station Co-ops\Angela Lian" & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
End Sub
It converts my file fine, however for what I have on sheet 2 it splits it up into multiple pages in the PDF because I guess it does not scale it to fit the page. I was wondering how I could modify the code to make it scale this sheet so it will fit on one page of the PDF.
Thanks!
I have a similar sub in one of the tools I use. Do you have your worksheet's width / height scale to fit properties set to 1 page?
For Each sh In mySheets
With Sheets(sh).PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Next sh
One of the weird things I've run into is scaling issues when converting to PDF with some chart / image objects. For instance a logo looks fine on screen but prints stretched on the pdf. I never fixed the problem, but through research it seemed due to the way the printer sees it compared to the screen resolution. Have you ever run into that problem?
Related
I am looking for some help to solve a save to PDF problem. I have a sheet with some information that prints on 2 pages. The information displayed on this sheet is controlled by a drop down option to select 1 of several hundred options. I have a print to PDF function working fine for a single view of the information displayed so I select 1 option using the drop down and click the save to PDF button which all works great.
I need to add a 2nd function that will loop through all of the options available in the drop down box and add all of this into a single PDF to be saved. I can handle all of the standard code in the loop but how do I build up the PDF file inside the loop. I know how to build an array of sheets to export to a single PDF but this kind of 'in loop' function is something I am struggling to find an answer to.
Can anyone help please? If you need any more info, please just ask.
Thanks
In the Solution, suppose that we have a table which named: Table2.
We have also a help sheet(to store filtered tables) which is Hiden and named: Help.
Option Explicit
Sub print_to_pdf()
Dim sh As Long
Dim rg As Range
Dim Rng As Range
Dim rw As Range
Application.ScreenUpdating = False
For Each rw In Range("Table2[#All]").Rows
If rw.EntireRow.Hidden = False Then
If Rng Is Nothing Then Set Rng = rw
Set Rng = Union(rw, Rng)
End If
Next
Rng.Copy
With Sheets("help")
.Visible = True
sh = .Cells(Rows.Count, "A").End(xlUp).Row + 2
Set rg = Range("a3" & ":" & "a" & sh - 2)
.Activate
.Cells(sh, "A").Select
ActiveSheet.Paste
ActiveSheet.PageSetup.PrintArea = rg
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\rep.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
.Visible = False
End With
Application.ScreenUpdating = True
MsgBox "Your PDF Has been Created with Success!!", vbInformation
End Sub
You can append data in Help sheet then export pdf.
Ref: https://stackoverflow.com/questions/
I' trying to automate the generation of small-sized screenshots directly from excel sheet by clicking a button with VBA code in the background. Here is the situation:
I have to take screenshot of cellrange G1:I12, and save it in a filename
called scrt.png. The size of the screenshot should remain exactly the same as that of cellrange G1:I12
From one of the earlier posts, I found this code which seems to work by first including the screenshot of the mentioned range to a new ChartSheet, and then it saves the scrt.png file at the mentioned location successfully. In essence, it successfully generates a bitmap of the selected cell range in the ChartSheet, and also generates the seperate scrt.png file at the mentioned location.
However, the problem with the code is that the scrt.png file that is created is having the whole ChartSheet screenshot. What I am looking for only the file saved with mentioned cell range snap.
Have tried to tweak the code, but no success. Any help will be greatly appreciated.
Sub Macro1()
myFileName = "scrt.png"
Range("G1:I12").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Charts.Add
ActiveChart.Paste
ActiveChart.Export Filename:=ThisWorkbook.Path & "\" & myFileName, Filtername:="PNG"
End Sub
Thanks a lot.
Instead of using a Chart sheet, use an embedded chartObject on a regular worksheet - then you can resize it before pasting in the copied range picture
Sub Tester()
ExportRange Selection, "C:\_Stuff\test\scrt.png"
End Sub
Sub ExportRange(rng As Range, sPath As String)
Dim cob, sc
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set cob = rng.Parent.ChartObjects.Add(10, 10, 200, 200)
'remove any series which may have been auto-added...
Set sc = cob.Chart.SeriesCollection
Do While sc.Count > 0
sc(1).Delete
Loop
With cob
.Height = rng.Height
.Width = rng.Width
.Chart.Paste
.Chart.Export Filename:=sPath, Filtername:="PNG"
.Delete
End With
End Sub
I'm a bit confused. The export from an excel sheet to a pdf file actual works fine. but after I added a new sentence in bottom of the sheet, it doesn't copy this sentence in the pdf file. My excel sheet contains a form of 180 cells. In 181 is the new sentence but it won't take this in pdf.
Could anyone tell me what the problem is presumably?
If you need more information, I would try to give you some more details.
Edit:
The export is defined as follows:
Worksheets(NameSheet).ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=File, _
Quality:=xlQualityStandard, _
IncludedocProperties:=True, _
IgnorePrintAreas:=False
The sentence is added directly in excel sheet without vba code. I searched in the code for .Cells(181,1) but nothing was defined. That means for me, in the pdf the sentence should be generated.
I figured out. That was a setting in excel.
the solution is described on this page: Set a print area
Description:
On the worksheet, select the cells that you want to define as the print area. (I selected all cells up to 181)
On the Page Layout tab, in the Page Setup group, click Print Area, and then click Set Print Area.
You can also manually set the print area if you want.
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.PrintArea = "$A$1:$AA$181"
.Zoom = False
.FitToPagesTall = False
.FitToPagesWide = 1
End With
I'm trying to programmatically copy a large range of cells from one workbook to another in VBA. I want to copy the formatting (including the entire source theme) and values, but NOT formulas. The following is my VBA code:
fromCells.Copy
toCells.PasteSpecial Paste:=xlPasteFormats
toCells.PasteSpecial Paste:=xlPasteColumnWidths
toCells.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Unfortunately, there are occasions when the above code doesn't work. This is usually with Font face and size. I noticed that whenever this happens, the only way to copy the font formatting across is to use xlPasteAllUsingSourceTheme, so it seems the font formatting is somehow registered to a 'source theme'. Unfortunately, xlPasteAllUsingSourceTheme doesn't work for me because it's copying formulas as well.
So is there a way to copy the source theme (formatting only) across? Or maybe a way to force copy all the font formatting across?
Note: Copying using xlPasteAllUsingSourceTheme and then overwriting it with xlPasteValues won't work for me because when the formulas is copied it keeps popping up message boxes telling me about issues with the formulas (such as conflicting named ranges used in the formulas, etc.).
I'm using Excel 2013. I noticed this problem doesn't seem to arise in Excel 2007 or earlier. Any help is appreciated.
Edit: I've also tried the following code (added to the beginning of the above code), it still doesn't work...
Dim themeTempFilePath As String
themeTempFilePath = Environ("temp") & "\" & fromWorkbook.Name & "Theme.xml"
fromWorkbook.Theme.ThemeFontScheme.Save themeTempFilePath
toWorkbook.Theme.ThemeFontScheme.Load themeTempFilePath
fromWorkbook.Theme.ThemeColorScheme.Save themeTempFilePath
toWorkbook.Theme.ThemeColorScheme.Load themeTempFilePath
Update: It seems the above code for saving and loading themes does work. The problematic text that I was looking at came from a different place - a form control. It was copied as a picture (using Shape.CopyPicture) but somehow the font gets changed in the process. However, I'll post this issue as another question.
For this question, I'll put up the theme saving and loading mechanism as an answer.
Try 1 or 2
Option Explicit
Public Sub copyWithoutFormulas_1()
xlEnabled False
With Sheet2
.EnableCalculation = False
.EnableFormatConditionsCalculation = False
.UsedRange.EntireColumn.Delete
Sheet1.UsedRange.Copy .Cells(1, 1)
.UsedRange.Value2 = .UsedRange.Value2
.EnableCalculation = True
.EnableFormatConditionsCalculation = True
End With
Application.CutCopyMode = False
xlEnabled True
End Sub
Public Sub copyWithoutFormulas_2()
xlEnabled False
Sheet1.Copy After:=Worksheets(Worksheets.Count)
With Worksheets(Worksheets.Count).UsedRange
.Value2 = .Value2
End With
xlEnabled True
End Sub
Private Sub xlEnabled(ByVal opt As Boolean)
With Application
.EnableEvents = opt
.DisplayAlerts = opt
.ScreenUpdating = opt
.Calculation = IIf(opt, xlCalculationAutomatic, xlCalculationManual)
End With
End Sub
To force copy the source theme to the destination cells, one can do the following. Unfortunately, this method will apply the source theme to the entire destination workbook, which is OK in my situation. Not sure if it's useful for anyone else.
Sub CopyText(fromCells As Range, toCells As Range, Optional copyTheme As Boolean = False)
If copyTheme Then
Dim fromWorkbook As Workbook
Dim toWorkbook As Workbook
Dim themeTempFilePath As String
Set fromWorkbook = fromCells.Worksheet.Parent
Set toWorkbook = toCells.Worksheet.Parent
themeTempFilePath = Environ("temp") & "\" & fromWorkbook.Name & "Theme.xml"
fromWorkbook.Theme.ThemeFontScheme.Save themeTempFilePath
toWorkbook.Theme.ThemeFontScheme.Load themeTempFilePath
fromWorkbook.Theme.ThemeColorScheme.Save themeTempFilePath
toWorkbook.Theme.ThemeColorScheme.Load themeTempFilePath
End If
Set toCells = toCells.Cells(1, 1).Resize(fromCells.Rows.Count, fromCells.Columns.Count)
fromCells.Copy
toCells.PasteSpecial Paste:=xlPasteFormats
toCells.PasteSpecial Paste:=xlPasteColumnWidths
toCells.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End Sub
I'm taking a enhanced meta file generated from another application (DPlot Jr) copying to the clipboard, and pasting it to an Excel(2007) worksheet. From there i use vba to convert that file to a pdf. This is the code i have to do that:
' copy the graph eml file to the clip board
ret = DPlot_Command(doc, "[CopyPicture()]")
' copy the clip board contents to a new temp worksheet (under the covers)
'Hide the application
Application.ScreenUpdating = False
'Create a new temp worksheet
Set ws = ActiveWorkbook.Sheets.Add(After:=Sheets(1))
ws.Name = "Temp_Graph_DPJR"
ws.Activate
'Paste to the temp worksheet
ActiveSheet.Paste
'Save as pdf from excel
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
filename:=pdf_filename, _
OpenAfterPublish:=False
I discovered that, the image that gets created in the PDF is slightly larger than the actual size of the graphic. For example, the width of the graphic should be 2.65". The size of the graph in the PDF is 2.816, so about .166" or 1 Pica, appears to be added.
While i could, and may have to, just decrease the size of the image initially by .166" that seems kind of hacky and I'd just like to have the image's original size to come over.
I discovered that if i paste the image to a Chartsheet, the size IS maintained, but the image becomes a bitmap on teh Chartsheet page.
When i create the pdf, i have all the correct settings. I have no margins, actual size, etc.
Has anyone else seen this? Can anyone help? I need to have the image as a pdf.
Thanks for any help!
Russ
Well, This is strange, and shouldn't make a difference, but it does, so far appear to work.
In the above workflow, after pasting the EMF to a worksheet, if i select that image THEN copy that to a new Chartsheet, the original size is maintained, as well as the vector nature of the graphic. Here is the code:
ret = DPlot_Command(doc, "[CopyPicture()]")
' copy the clip board contents to a new temp worksheet (under the covers)
'Hide the application
Application.ScreenUpdating = False
'Create a new temp worksheet
Set ws = ActiveWorkbook.Sheets.Add(After:=Sheets(1))
ws.Name = "Temp_Graph_DPJR"
ws.Activate
'Paste to the temp worksheet then select/copy that one
ActiveSheet.Paste
Selection.Copy
'Create a new temp chart
Set temp_chart = ActiveWorkbook.Charts.Add
'temp_chart.Name = "Temp_Chart"
'Set the linesytle of the border to none
temp_chart.ChartArea.Border.LineStyle = xlNone
'Paste the dplotjr graph to the chart sheet
'We had to do this as this maintained the size of the graph
'Dumb MS Excel worksheet
temp_chart.Paste
'Paste to the temp worksheet
'ActiveSheet.Paste
'Save as pdf from excel
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
filename:=pdf_filename, _
OpenAfterPublish:=False
It is almost as though Excel determines that the paste is from another app and pastes a bitmap to the chartsheet, but if it determines that it is from itself, it pastes as a vector image. This maybe a loophole that might go away in the future, but it seems to work so far.
fwiw!