This macro will print all of the cell values and formulas to Microsoft Word. The Word application will
remain open and active. You may then save or print the document. Make sure that
you have enabled references to Word objects, from the Tools->References menu.
Public Sub PrintFormulasToWord()
Dim Cnt As String
Dim C As Range
Dim WordObj As word.Application
Dim HasArr As Boolean
On Error Resume Next
Err.Number = 0
Set WordObj = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set WordObj = CreateObject("Word.Application")
Err.Number = 0
End If
WordObj.Visible = True
WordObj.Documents.Add
With WordObj.Selection
.Font.Name = "Courier New"
.TypeText "Formulas In Worksheet: " + ActiveSheet.Name
.TypeParagraph
.TypeText "Cells: " + Selection.Cells(1,1).Address(False,False,xlA1) _ & " to " & Selection.Cells(Selection.Rows.Count, _
Selection.Columns.Count).Address(False, False, xlA1)
.TypeParagraph
.TypeParagraph
End With
For Each C In Selection
HasArr = C.HasArray
Cnt = C.Formula
If HasArr Then
Cnt = "{" + Cnt + "}"
End If
If Cnt <> "" Then
With WordObj.Selection
.Font.Bold = True
.TypeText C.Address(False, False, xlA1) & ": "
.Font.Bold = False
.TypeText Cnt
.TypeParagraph
.TypeParagraph
End With
End If
Next C
MsgBox "Done printing formulas to Word. ", , "Print Formulas To Word"
End Sub
remain open and active. You may then save or print the document. Make sure that
you have enabled references to Word objects, from the Tools->References menu.
Public Sub PrintFormulasToWord()
Dim Cnt As String
Dim C As Range
Dim WordObj As word.Application
Dim HasArr As Boolean
On Error Resume Next
Err.Number = 0
Set WordObj = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set WordObj = CreateObject("Word.Application")
Err.Number = 0
End If
WordObj.Visible = True
WordObj.Documents.Add
With WordObj.Selection
.Font.Name = "Courier New"
.TypeText "Formulas In Worksheet: " + ActiveSheet.Name
.TypeParagraph
.TypeText "Cells: " + Selection.Cells(1,1).Address(False,False,xlA1) _ & " to " & Selection.Cells(Selection.Rows.Count, _
Selection.Columns.Count).Address(False, False, xlA1)
.TypeParagraph
.TypeParagraph
End With
For Each C In Selection
HasArr = C.HasArray
Cnt = C.Formula
If HasArr Then
Cnt = "{" + Cnt + "}"
End If
If Cnt <> "" Then
With WordObj.Selection
.Font.Bold = True
.TypeText C.Address(False, False, xlA1) & ": "
.Font.Bold = False
.TypeText Cnt
.TypeParagraph
.TypeParagraph
End With
End If
Next C
MsgBox "Done printing formulas to Word. ", , "Print Formulas To Word"
End Sub
No comments:
Post a Comment