S
Steven
I have a macro that copies the used range from sheet1, and paste into
MS word. Actually, this macro works fine for me. I get what I want but
I want MS word is active and visible after this "paste" process.
Please someone help me...
Thank you for taking your time to read this.
________________________________________________________________
Sub MyUsedRange()
Dim ar As Range, r As Double, c As Integer, tr As Double, tc As Integer
Dim ur As Range, fr As Double, fc As Integer, tfr As Double, tfc As
Integer
On Error Resume Next
fc = ActiveSheet.Columns.Count
fr = ActiveSheet.Rows.Count
Set ur =
Union(ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants), _
ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas))
If Err.Number = 1004 Then
Err.Clear
Set ur = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
End If
If Err.Number = 1004 Then
Err.Clear
Set ur = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
End If
If Err.Number = 0 Then
For Each ar In ur.Areas
'tr = ar.Range("A1").Row + ar.Rows.Count - 1
tr = (ar.Range("A1").Row + 17) + ar.Rows.Count - 1
'tc = ar.Range("A1").Column + ar.Columns.Count - 1
tc = ar.Range("A1").Column - 1 + ar.Columns.Count - 1
If tc > c Then c = tc
If tr > r Then r = tr
tfr = ar.Range("A1").Row
'tfc = ar.Range("A1").Column
tfc = ar.Range("A1").Column - 1
If tfc < fc Then fc = tfc
If tfr < fr Then fr = tfr
Next
Range(Cells(fr, fc), Cells(r, c)).Select
ElseIf Err.Number = 1004 Then
'Range("A1").Select
End If
End Sub
Sub PasteTableToWord()
Dim obj As Object
Dim temp As String
'Activate the worksheet containing the range to be copied
Worksheets("bpv").Activate
'Calling actual used range.
Call MyUsedRange
'Format the selection
Selection.ColumnWidth = 6.35
With Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
'Copy the cells
Selection.Copy
'Create a word object.
Set obj = CreateObject("word.basic")
'Create a new file.
obj.filenew
'Paste the Microsoft Excel Spreadsheet object into Word
obj.EditPasteSpecial Link:=1, Class:="Excel.Sheet.5", _
DataType:="object", IconFilename:="", _
Caption:="Microsoft Excel Worksheet"
'Save the file
obj.FileSaveAs Name:="RML EF Interop.doc"
'Close Word.
'Set obj = Nothing
'Return to Microsoft Excel. If this line is not used, the
focus
'may be set to another Windows Application
' AppActivate "Word.basic"
'Deselect the selected range
'Application.CutCopyMode = False
End Sub
MS word. Actually, this macro works fine for me. I get what I want but
I want MS word is active and visible after this "paste" process.
Please someone help me...
Thank you for taking your time to read this.
________________________________________________________________
Sub MyUsedRange()
Dim ar As Range, r As Double, c As Integer, tr As Double, tc As Integer
Dim ur As Range, fr As Double, fc As Integer, tfr As Double, tfc As
Integer
On Error Resume Next
fc = ActiveSheet.Columns.Count
fr = ActiveSheet.Rows.Count
Set ur =
Union(ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants), _
ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas))
If Err.Number = 1004 Then
Err.Clear
Set ur = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
End If
If Err.Number = 1004 Then
Err.Clear
Set ur = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
End If
If Err.Number = 0 Then
For Each ar In ur.Areas
'tr = ar.Range("A1").Row + ar.Rows.Count - 1
tr = (ar.Range("A1").Row + 17) + ar.Rows.Count - 1
'tc = ar.Range("A1").Column + ar.Columns.Count - 1
tc = ar.Range("A1").Column - 1 + ar.Columns.Count - 1
If tc > c Then c = tc
If tr > r Then r = tr
tfr = ar.Range("A1").Row
'tfc = ar.Range("A1").Column
tfc = ar.Range("A1").Column - 1
If tfc < fc Then fc = tfc
If tfr < fr Then fr = tfr
Next
Range(Cells(fr, fc), Cells(r, c)).Select
ElseIf Err.Number = 1004 Then
'Range("A1").Select
End If
End Sub
Sub PasteTableToWord()
Dim obj As Object
Dim temp As String
'Activate the worksheet containing the range to be copied
Worksheets("bpv").Activate
'Calling actual used range.
Call MyUsedRange
'Format the selection
Selection.ColumnWidth = 6.35
With Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
'Copy the cells
Selection.Copy
'Create a word object.
Set obj = CreateObject("word.basic")
'Create a new file.
obj.filenew
'Paste the Microsoft Excel Spreadsheet object into Word
obj.EditPasteSpecial Link:=1, Class:="Excel.Sheet.5", _
DataType:="object", IconFilename:="", _
Caption:="Microsoft Excel Worksheet"
'Save the file
obj.FileSaveAs Name:="RML EF Interop.doc"
'Close Word.
'Set obj = Nothing
'Return to Microsoft Excel. If this line is not used, the
focus
'may be set to another Windows Application
' AppActivate "Word.basic"
'Deselect the selected range
'Application.CutCopyMode = False
End Sub