crvazquez954
New Member
- Joined
- Jul 9, 2019
- Messages
- 23
I created a spreadsheet that pulls data from various tabs and summarizes it on the main page. Excel then exports the data to a word template. What I would like to do is have the data converted to PDF and attached to an email. Can anyone help me tweak the VBA code I currently have to accomplish this? Below is what I am working with. Any hep would be appreciated.
Sub Export_To_Word()
'Name of the existing Word doc.
Const stWordReport As String = "Proposal.docm"
'Word objects.
Dim pappWord As Object
Dim docWord As Object
Dim wdbmRange As Word.Range
'Excel objects.
Dim wb As Excel.Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
Dim r As Range
Dim xlName As Excel.Name
Dim TodayDate As String
'Initialize the Excel objects.
Set wb = ActiveWorkbook
Set wsSheet = wb.Worksheets("Summary")
Set rnReport = wsSheet.Range("BidTable")
'Turn off screen updating.
Application.ScreenUpdating = False
'Remove formatting
Range("B28:D47").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For Each r In rnReport.Rows
If WorksheetFunction.Count(r) = 0 Then r.Hidden = True
Next
'Initialize the Word objects.
Set pappWord = New Word.Application
Set docWord = pappWord.Documents.Open(wb.Path & "" & stWordReport)
Set wdbmRange = docWord.Bookmarks("BidTable").Range
pappWord.Visible = True
'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
On Error Resume Next
With docWord.InlineShapes(1)
.Select
.Delete
End With
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If
Next xlName
On Error GoTo 0
rnReport.Copy 'Copy the report to the clipboard.
'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
With wdbmRange
.Select
.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
End With
'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
'Unhide hidden rows
Rows("26:48").Select
Selection.EntireRow.Hidden = False
'Restore formatting
Range("B28:D47").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Application.ScreenUpdating = True
End Sub
Sub Export_To_Word()
'Name of the existing Word doc.
Const stWordReport As String = "Proposal.docm"
'Word objects.
Dim pappWord As Object
Dim docWord As Object
Dim wdbmRange As Word.Range
'Excel objects.
Dim wb As Excel.Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
Dim r As Range
Dim xlName As Excel.Name
Dim TodayDate As String
'Initialize the Excel objects.
Set wb = ActiveWorkbook
Set wsSheet = wb.Worksheets("Summary")
Set rnReport = wsSheet.Range("BidTable")
'Turn off screen updating.
Application.ScreenUpdating = False
'Remove formatting
Range("B28:D47").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For Each r In rnReport.Rows
If WorksheetFunction.Count(r) = 0 Then r.Hidden = True
Next
'Initialize the Word objects.
Set pappWord = New Word.Application
Set docWord = pappWord.Documents.Open(wb.Path & "" & stWordReport)
Set wdbmRange = docWord.Bookmarks("BidTable").Range
pappWord.Visible = True
'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
On Error Resume Next
With docWord.InlineShapes(1)
.Select
.Delete
End With
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If
Next xlName
On Error GoTo 0
rnReport.Copy 'Copy the report to the clipboard.
'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
With wdbmRange
.Select
.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
End With
'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
'Unhide hidden rows
Rows("26:48").Select
Selection.EntireRow.Hidden = False
'Restore formatting
Range("B28:D47").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Application.ScreenUpdating = True
End Sub
