Hi,
We managed to write a macro to copy text from PDF to excel. It works, however when it copies the data to excel, it fails to retain the original format. All we need the text to appear Justified and aligned correctly.
Sub RoundedRectangle1_Click()
Application.DisplayAlerts = False
Application.EnableEvents = True
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'==========================================='
Call Portfolio
'==========================================='
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub Portfolio()
Dim WrdArray() As String
Dim StrPath As String
Dim SrtFolderPath As String
SrtFolderPath = InputBox(prompt:="Enter the Full Path Here", Title:="Enter Path", Default:="P:\REPORTING\LOCATION - REPORTING\London\FUNDS\Miscellaneous\Macro-RBC Transactions")
StrTemplatePath = "U:\Visakh"
MyFolder = SrtFolderPath
Dim fls, f
Set fls = GetFiles(SrtFolderPath & "", "*.pdf*")
path = StrTemplatePath & ""
'## Open both workbooks first:
Set x = Workbooks.Open(StrTemplatePath & "Template.xlsx")
For Each f In fls
'MyOldFile = Shell("C:\Program Files (x86)\Adobe\Reader 10.0\Reader\AcroRd32.exe " & f, vbNormalFocus)
ActiveWorkbook.FollowHyperlink f
'send key to select all text
SendKeys "^a", True
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' send key to copy
SendKeys "^c"
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' activate this workook and paste the data
x.Activate
Sheets("Sheet1").Select
Columns(1).ClearContents
Range("A2").Select
ActiveSheet.Paste
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value Like "*Important information*") Then
Rows(i & ":" & Last).EntireRow.Delete
End If
Next i
'=========================================================================='
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value Like "*Fund facts*") Or (Cells(i, "A").Value Like "*Fund launch*") Then
strfundfacts = i + 20
End If
Next i
'=========================================================================='
strfundfactsnew = strfundfacts - 20
For Each Cell In ActiveSheet.Range("A" & strfundfactsnew & ":A" & strfundfacts)
If Cell.Value Like "*Morgan Stanley Investment*" Then
matchRow = Cell.Row
Rows(strfundfactsnew & ":" & matchRow).EntireRow.Delete
End If
Next
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value Like "*Fund facts*") Or (Cells(i, "A").Value Like "*Fund fact s*") Then
Rows(i).EntireRow.Delete
End If
Next i
'=========================================================================='
' send key to close pdf file
SendKeys "^q"
Application.Wait Now + TimeValue("00:00:2")
On Error Resume Next
'MyNewFile = MyFolder & "" & StrAccountnumber & ".pdf"
MyNewFile = MyFolder & "\rahul.pdf"
'If FileThere(path & StrNewFileName) Then
'Else
Name f As path & MyNewFile
'End If
On Error GoTo 0
Application.Wait Now + TimeValue("00:00:2")
Next f
x.Activate
Lastt = Cells(Rows.count, "A").End(xlUp).Row
Range("A1:A" & Lastt).Select
Range("A1:A" & Lastt).HorizontalAlignment = xlJustify
Range("A1:A" & Lastt).VerticalAlignment = xlTop
Selection.Copy
Set x1 = Workbooks.Open(StrTemplatePath & "Final_output.xls")
Sheets(1).Select
Range("A12:J150").ClearComments
Range("A12").Select
On Error Resume Next
ActiveSheet.Paste
On Error GoTo 0
Range("A12:A150").HorizontalAlignment = xlPageBreakFull
Range("A12:A150").VerticalAlignment = xlTop
Range("A12:A150").Rows.AutoFit
'========== Merge Cells in Commentary ============================== '
Range("A12:J12").Merge
Range("A13:J13").Merge
Range("A14:J14").Merge
Range("A15:J15").Merge
Range("A16:J16").Merge
Range("A17:J17").Merge
Range("A18:J18").Merge
Range("A19:J19").Merge
Range("A20:J20").Merge
Range("A21:J21").Merge
Range("A22:J22").Merge
Range("A23:J23").Merge
Range("A24:J24").Merge
Range("A25:J25").Merge
Range("A26:J26").Merge
Range("A27:J27").Merge
Range("A28:J28").Merge
Range("A29:J29").Merge
Range("A30:J30").Merge
Range("A31:J31").Merge
Range("A32:J32").Merge
Range("A33:J33").Merge
Range("A34:J34").Merge
Range("A35:J35").Merge
Range("A36:J36").Merge
Range("A37:J37").Merge
Range("A38:J38").Merge
Range("A39:J39").Merge
Range("A40:J40").Merge
Range("A41:J41").Merge
Range("A42:J42").Merge
Range("A43:J43").Merge
Range("A44:J44").Merge
Range("A45:J45").Merge
Range("A46:J46").Merge
Range("A47:J47").Merge
Range("A48:J48").Merge
Range("A49:J49").Merge
Range("A50:J50").Merge
Range("A51:J51").Merge
Range("A52:J52").Merge
Range("A53:J53").Merge
Range("A54:J54").Merge
Range("A55:J55").Merge
Range("A56:J56").Merge
Range("A57:J57").Merge
Range("A58:J58").Merge
Range("A59:J59").Merge
Range("A60:J60").Merge
Range("A61:J61").Merge
Range("A62:J62").Merge
Range("A63:J63").Merge
Range("A64:J64").Merge
Range("A65:J65").Merge
Range("A66:J66").Merge
Range("A67:J67").Merge
Range("A68:J68").Merge
Range("A69:J69").Merge
Range("A70:J70").Merge
Range("A71:J71").Merge
Range("A72:J72").Merge
Range("A73:J73").Merge
Range("A74:J74").Merge
Range("A75:J75").Merge
Range("A76:J76").Merge
Range("A77:J77").Merge
Range("A78:J78").Merge
Range("A79:J79").Merge
Range("A80:J80").Merge
Range("A81:J81").Merge
Range("A82:J82").Merge
Range("A83:J83").Merge
Range("A84:J84").Merge
Range("A85:J85").Merge
Range("A86:J86").Merge
Range("A87:J87").Merge
Range("A88:J88").Merge
Range("A89:J89").Merge
Range("A90:J90").Merge
Range("A91:J91").Merge
Range("A92:J92").Merge
Range("A93:J93").Merge
Range("A94:J94").Merge
Range("A95:J95").Merge
Range("A96:J96").Merge
Range("A97:J97").Merge
Range("A98:J98").Merge
Range("A99:J99").Merge
Range("A100:J100").Merge
Range("A101:J101").Merge
Range("A102:J102").Merge
Range("A103:J103").Merge
Range("A104:J104").Merge
Range("A105:J105").Merge
Range("A106:J106").Merge
Range("A107:J107").Merge
Range("A108:J108").Merge
Range("A109:J109").Merge
Range("A110:J110").Merge
Range("A111:J111").Merge
Range("A112:J112").Merge
Range("A113:J113").Merge
Range("A114:J114").Merge
Range("A115:J115").Merge
Range("A116:J116").Merge
Range("A117:J117").Merge
Range("A118:J118").Merge
Range("A119:J119").Merge
Range("A120:J120").Merge
Range("A121:J121").Merge
Range("A122:J122").Merge
Range("A123:J123").Merge
Range("A124:J124").Merge
Range("A125:J125").Merge
Range("A126:J126").Merge
Range("A127:J127").Merge
Range("A128:J128").Merge
Range("A129:J129").Merge
Range("A130:J130").Merge
Range("A131:J131").Merge
Range("A132:J132").Merge
Range("A133:J133").Merge
Range("A134:J134").Merge
Range("A135:J135").Merge
Range("A136:J136").Merge
Range("A137:J137").Merge
Range("A138:J138").Merge
Range("A139:J139").Merge
Range("A140:J140").Merge
Range("A141:J141").Merge
Range("A142:J142").Merge
Range("A143:J143").Merge
Range("A144:J144").Merge
Range("A145:J145").Merge
Range("A146:J146").Merge
Range("A147:J147").Merge
Range("A148:J148").Merge
Range("A149:J149").Merge
Range("A150:J150").Merge
'========== Merge Cells in Commentary ============================== '
Range("A12:A150").Rows.AutoFit
Range("A12:J150").Select
Range("A12:J150").Font.Size = 14
Call sbVBS_To_Delete_Blank_Rows_In_Range
'========= Copy Excel to Word Doc File ========================='
Call ypadtorightFor50CharacterString
x.Close
x1.Activate
Call ExportToPDF
MsgBox "Macro Complete."
End Sub
Function GetFiles(path As String, Optional pattern As String = "") As Collection
Dim rv As New Collection, f
If Right(path, 1) <> "" Then path = path & ""
f = Dir(path & pattern)
Do While Len(f) > 0
rv.Add path & f
f = Dir() 'no parameter
Loop
Set GetFiles = rv
End Function
Function FileThere(FileName As String) As Boolean
FileThere = (Dir(FileName) > "")
End Function
Sub ExportToPDF()
Sheets(1).Activate
ActiveSheet.UsedRange.Select
strdate = Date
strdate = Format(strdate, "dd-mm-yyyy")
Call PDFFormat
Sheets(1).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"U:" & strdate & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub
Function PDFFormat()
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(1)
.RightMargin = Application.InchesToPoints(1)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End Function
Sub sbVBS_To_Delete_Blank_Rows_In_Range()
Dim iCntr
Dim rng As Range
Set rng = Range("A12:A150")
For iCntr = rng.Row + rng.Rows.count - 1 To rng.Row Step -1
If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete
Next
End Sub
Sub ypadtorightFor50CharacterString()
For Each Cell In [a:a]
If Cell = "" Then Exit Sub
Cell.Value = Cell.Value & WorksheetFunction.Rept(" ", 50 - Len(Cell))
Next Cell
End Sub
We managed to write a macro to copy text from PDF to excel. It works, however when it copies the data to excel, it fails to retain the original format. All we need the text to appear Justified and aligned correctly.
Sub RoundedRectangle1_Click()
Application.DisplayAlerts = False
Application.EnableEvents = True
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'==========================================='
Call Portfolio
'==========================================='
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub Portfolio()
Dim WrdArray() As String
Dim StrPath As String
Dim SrtFolderPath As String
SrtFolderPath = InputBox(prompt:="Enter the Full Path Here", Title:="Enter Path", Default:="P:\REPORTING\LOCATION - REPORTING\London\FUNDS\Miscellaneous\Macro-RBC Transactions")
StrTemplatePath = "U:\Visakh"
MyFolder = SrtFolderPath
Dim fls, f
Set fls = GetFiles(SrtFolderPath & "", "*.pdf*")
path = StrTemplatePath & ""
'## Open both workbooks first:
Set x = Workbooks.Open(StrTemplatePath & "Template.xlsx")
For Each f In fls
'MyOldFile = Shell("C:\Program Files (x86)\Adobe\Reader 10.0\Reader\AcroRd32.exe " & f, vbNormalFocus)
ActiveWorkbook.FollowHyperlink f
'send key to select all text
SendKeys "^a", True
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' send key to copy
SendKeys "^c"
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' activate this workook and paste the data
x.Activate
Sheets("Sheet1").Select
Columns(1).ClearContents
Range("A2").Select
ActiveSheet.Paste
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value Like "*Important information*") Then
Rows(i & ":" & Last).EntireRow.Delete
End If
Next i
'=========================================================================='
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value Like "*Fund facts*") Or (Cells(i, "A").Value Like "*Fund launch*") Then
strfundfacts = i + 20
End If
Next i
'=========================================================================='
strfundfactsnew = strfundfacts - 20
For Each Cell In ActiveSheet.Range("A" & strfundfactsnew & ":A" & strfundfacts)
If Cell.Value Like "*Morgan Stanley Investment*" Then
matchRow = Cell.Row
Rows(strfundfactsnew & ":" & matchRow).EntireRow.Delete
End If
Next
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value Like "*Fund facts*") Or (Cells(i, "A").Value Like "*Fund fact s*") Then
Rows(i).EntireRow.Delete
End If
Next i
'=========================================================================='
' send key to close pdf file
SendKeys "^q"
Application.Wait Now + TimeValue("00:00:2")
On Error Resume Next
'MyNewFile = MyFolder & "" & StrAccountnumber & ".pdf"
MyNewFile = MyFolder & "\rahul.pdf"
'If FileThere(path & StrNewFileName) Then
'Else
Name f As path & MyNewFile
'End If
On Error GoTo 0
Application.Wait Now + TimeValue("00:00:2")
Next f
x.Activate
Lastt = Cells(Rows.count, "A").End(xlUp).Row
Range("A1:A" & Lastt).Select
Range("A1:A" & Lastt).HorizontalAlignment = xlJustify
Range("A1:A" & Lastt).VerticalAlignment = xlTop
Selection.Copy
Set x1 = Workbooks.Open(StrTemplatePath & "Final_output.xls")
Sheets(1).Select
Range("A12:J150").ClearComments
Range("A12").Select
On Error Resume Next
ActiveSheet.Paste
On Error GoTo 0
Range("A12:A150").HorizontalAlignment = xlPageBreakFull
Range("A12:A150").VerticalAlignment = xlTop
Range("A12:A150").Rows.AutoFit
'========== Merge Cells in Commentary ============================== '
Range("A12:J12").Merge
Range("A13:J13").Merge
Range("A14:J14").Merge
Range("A15:J15").Merge
Range("A16:J16").Merge
Range("A17:J17").Merge
Range("A18:J18").Merge
Range("A19:J19").Merge
Range("A20:J20").Merge
Range("A21:J21").Merge
Range("A22:J22").Merge
Range("A23:J23").Merge
Range("A24:J24").Merge
Range("A25:J25").Merge
Range("A26:J26").Merge
Range("A27:J27").Merge
Range("A28:J28").Merge
Range("A29:J29").Merge
Range("A30:J30").Merge
Range("A31:J31").Merge
Range("A32:J32").Merge
Range("A33:J33").Merge
Range("A34:J34").Merge
Range("A35:J35").Merge
Range("A36:J36").Merge
Range("A37:J37").Merge
Range("A38:J38").Merge
Range("A39:J39").Merge
Range("A40:J40").Merge
Range("A41:J41").Merge
Range("A42:J42").Merge
Range("A43:J43").Merge
Range("A44:J44").Merge
Range("A45:J45").Merge
Range("A46:J46").Merge
Range("A47:J47").Merge
Range("A48:J48").Merge
Range("A49:J49").Merge
Range("A50:J50").Merge
Range("A51:J51").Merge
Range("A52:J52").Merge
Range("A53:J53").Merge
Range("A54:J54").Merge
Range("A55:J55").Merge
Range("A56:J56").Merge
Range("A57:J57").Merge
Range("A58:J58").Merge
Range("A59:J59").Merge
Range("A60:J60").Merge
Range("A61:J61").Merge
Range("A62:J62").Merge
Range("A63:J63").Merge
Range("A64:J64").Merge
Range("A65:J65").Merge
Range("A66:J66").Merge
Range("A67:J67").Merge
Range("A68:J68").Merge
Range("A69:J69").Merge
Range("A70:J70").Merge
Range("A71:J71").Merge
Range("A72:J72").Merge
Range("A73:J73").Merge
Range("A74:J74").Merge
Range("A75:J75").Merge
Range("A76:J76").Merge
Range("A77:J77").Merge
Range("A78:J78").Merge
Range("A79:J79").Merge
Range("A80:J80").Merge
Range("A81:J81").Merge
Range("A82:J82").Merge
Range("A83:J83").Merge
Range("A84:J84").Merge
Range("A85:J85").Merge
Range("A86:J86").Merge
Range("A87:J87").Merge
Range("A88:J88").Merge
Range("A89:J89").Merge
Range("A90:J90").Merge
Range("A91:J91").Merge
Range("A92:J92").Merge
Range("A93:J93").Merge
Range("A94:J94").Merge
Range("A95:J95").Merge
Range("A96:J96").Merge
Range("A97:J97").Merge
Range("A98:J98").Merge
Range("A99:J99").Merge
Range("A100:J100").Merge
Range("A101:J101").Merge
Range("A102:J102").Merge
Range("A103:J103").Merge
Range("A104:J104").Merge
Range("A105:J105").Merge
Range("A106:J106").Merge
Range("A107:J107").Merge
Range("A108:J108").Merge
Range("A109:J109").Merge
Range("A110:J110").Merge
Range("A111:J111").Merge
Range("A112:J112").Merge
Range("A113:J113").Merge
Range("A114:J114").Merge
Range("A115:J115").Merge
Range("A116:J116").Merge
Range("A117:J117").Merge
Range("A118:J118").Merge
Range("A119:J119").Merge
Range("A120:J120").Merge
Range("A121:J121").Merge
Range("A122:J122").Merge
Range("A123:J123").Merge
Range("A124:J124").Merge
Range("A125:J125").Merge
Range("A126:J126").Merge
Range("A127:J127").Merge
Range("A128:J128").Merge
Range("A129:J129").Merge
Range("A130:J130").Merge
Range("A131:J131").Merge
Range("A132:J132").Merge
Range("A133:J133").Merge
Range("A134:J134").Merge
Range("A135:J135").Merge
Range("A136:J136").Merge
Range("A137:J137").Merge
Range("A138:J138").Merge
Range("A139:J139").Merge
Range("A140:J140").Merge
Range("A141:J141").Merge
Range("A142:J142").Merge
Range("A143:J143").Merge
Range("A144:J144").Merge
Range("A145:J145").Merge
Range("A146:J146").Merge
Range("A147:J147").Merge
Range("A148:J148").Merge
Range("A149:J149").Merge
Range("A150:J150").Merge
'========== Merge Cells in Commentary ============================== '
Range("A12:A150").Rows.AutoFit
Range("A12:J150").Select
Range("A12:J150").Font.Size = 14
Call sbVBS_To_Delete_Blank_Rows_In_Range
'========= Copy Excel to Word Doc File ========================='
Call ypadtorightFor50CharacterString
x.Close
x1.Activate
Call ExportToPDF
MsgBox "Macro Complete."
End Sub
Function GetFiles(path As String, Optional pattern As String = "") As Collection
Dim rv As New Collection, f
If Right(path, 1) <> "" Then path = path & ""
f = Dir(path & pattern)
Do While Len(f) > 0
rv.Add path & f
f = Dir() 'no parameter
Loop
Set GetFiles = rv
End Function
Function FileThere(FileName As String) As Boolean
FileThere = (Dir(FileName) > "")
End Function
Sub ExportToPDF()
Sheets(1).Activate
ActiveSheet.UsedRange.Select
strdate = Date
strdate = Format(strdate, "dd-mm-yyyy")
Call PDFFormat
Sheets(1).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"U:" & strdate & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub
Function PDFFormat()
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(1)
.RightMargin = Application.InchesToPoints(1)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End Function
Sub sbVBS_To_Delete_Blank_Rows_In_Range()
Dim iCntr
Dim rng As Range
Set rng = Range("A12:A150")
For iCntr = rng.Row + rng.Rows.count - 1 To rng.Row Step -1
If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete
Next
End Sub
Sub ypadtorightFor50CharacterString()
For Each Cell In [a:a]
If Cell = "" Then Exit Sub
Cell.Value = Cell.Value & WorksheetFunction.Rept(" ", 50 - Len(Cell))
Next Cell
End Sub
