Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Export Excel Range to MS Word

1 view
Skip to first unread message

Timothy Ames

unread,
May 19, 2003, 1:13:19 PM5/19/03
to

I'm trying to write a macro that will enable an Excel range
A5:J30; saved as a CSV (comma delimited) to be used in MS Word.

Please help. The Excel export file will be used on a regular basis.


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Tom Ogilvy

unread,
May 19, 2003, 2:04:23 PM5/19/03
to
Chip Pearson has code that will write a specified range as a CSV file:

http://www.cpearson.com/excel/imptext.htm

you might have to modify it slightly to do exactly what you want.

Once written as a CSV file, word should be able to open it.

Regards,
Tom Ogilvy

"Timothy Ames" <ta...@dot.state.az.us> wrote in message
news:Ol7uyni...@TK2MSFTNGP11.phx.gbl...

Henrik Wendel

unread,
May 19, 2003, 2:03:16 PM5/19/03
to
Straight from John Walkenbach book. // Wendel

Sub ExportRange()
Dim Filename As String
Dim NumRows As Long, NumCols As Integer
Dim r As Long, c As Integer
Dim Data
Dim ExpRng As Range
Set ExpRng = Selection 'Here the range to be exported is set
NumCols = ExpRng.Columns.Count
NumRows = ExpRng.Rows.Count
Filename = "c:\windows\desktop\textfile.txt"
Open Filename For Output As #1
For r = 1 To NumRows
For c = 1 To NumCols
Data = ExpRng.Cells(r, c).Value
If IsNumeric(Data) Then Data = Val(Data)
If IsEmpty(ExpRng.Cells(r, c)) Then Data = ""
If c <> NumCols Then
Write #1, Data;
Else
Write #1, Data
End If
Next c
Next r
Close #1
End Sub

"Timothy Ames" <ta...@dot.state.az.us> skrev i meddelandet
news:Ol7uyni...@TK2MSFTNGP11.phx.gbl...

Henrik Wendel

unread,
May 19, 2003, 2:04:08 PM5/19/03
to
Here is the Import sub as well: //Wendel

Sub ImportRange()
Dim ImpRng As Range
Dim Filename As String


Dim r As Long, c As Integer

Dim txt As String, Char As String * 1
Dim Data
Dim i As Integer

Set ImpRng = ActiveCell
On Error Resume Next


Filename = "c:\windows\desktop\textfile.txt"

Open Filename For Input As #1
If Err <> 0 Then
MsgBox "Not found: " & Filename, vbCritical, "ERROR"
Exit Sub
End If
r = 0
c = 0
txt = ""
Application.ScreenUpdating = False
Do Until EOF(1)
Line Input #1, Data
For i = 1 To Len(Data)
Char = Mid(Data, i, 1)
If Char = "," Then 'comma
ActiveCell.Offset(r, c) = txt
c = c + 1
txt = ""
ElseIf i = Len(Data) Then 'end of line
If Char <> Chr(34) Then txt = txt & Char
ActiveCell.Offset(r, c) = txt
txt = ""
ElseIf Char <> Chr(34) Then
txt = txt & Char
End If
Next i
c = 0
r = r + 1
Loop
Close #1
Application.ScreenUpdating = True
End Sub

"Timothy Ames" <ta...@dot.state.az.us> skrev i meddelandet
news:Ol7uyni...@TK2MSFTNGP11.phx.gbl...
>

0 new messages