View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Steven Steven is offline
external usenet poster
 
Posts: 12
Default I need to make MS word visible..please help

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(xlCellTyp eConstants), _
ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormu las))
If Err.Number = 1004 Then
Err.Clear
Set ur = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConst ants)
End If
If Err.Number = 1004 Then
Err.Clear
Set ur = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormu las)
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