thedark123
06-14-2006, 08:40 PM
Progress: I got my coding to copy the selected range of cells in excel and then paste that copied cells to a new word document.
Private Sub CommandButton1_Click()
Dim x
' Prompt the user for the folder to list.
x = InputBox("What folder do you want to list?" & Chr$(13) & Chr$(13) _
& "For example: C:\My Documents")
If x = "" Or x = " " Then
Response = MsgBox("Please Enter a Directory Location" _
& Chr$(13) & Chr$(13) & _
"To enter directory location, click No." & Chr$(13) & _
"To Exit, click Yes.", vbYesNo)
If Response = "6" Then
End If
Else
' Search Drive
ChDrive "C"
ChDir x
On Error Resume Next
' Place .xls files into worksheet and tabulate data
outrow = 2
filess = Dir("*.xls")
While Not filess = ""
Workbooks.Open Filename:=filess, UpdateLinks:=False
' requires a reference to the Word Object library:
' in the VBE select Tools, References and check the Microsoft Word X.X object library
Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet
Application.ScreenUpdating = False
Application.StatusBar = "Creating new document..."
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Add
For Each ws In ActiveWorkbook.Worksheets
Application.StatusBar = "Copying data from " & ws.Name & "..."
'ws.UsedRange.Copy ' or edit to the range you want to copy
ws.Range("D3:l8").Copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
Application.CutCopyMode = False
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
' insert page break after all worksheets except the last one
If Not ws.Name = Worksheets(Worksheets.Count).Name Then
With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
End If
Next ws
Set ws = Nothing
Application.StatusBar = "Cleaning up..."
' apply normal view
With wdApp.ActiveWindow
If .View.SplitSpecial = wdPaneNone Then
.ActivePane.View.Type = wdNormalView
Else
.View.Type = wdNormalView
End If
End With
Set wdDoc = Nothing
wdApp.Visible = True
Set wdApp = Nothing
Application.StatusBar = False
filess = Dir()
Wend
End If
End Sub
Problem:
1)The first problem I encountered now is how to format that range of copied cells to the one shown in the screenshot 2,
2)As you can see from screenshot 1, I copied over 5 columns, how to make each column to be in the table format shown in screenshot 2?
In screenshot 3, is the final result I needed can anyone guide me to that way?
If I am not clear in any part of my explanation please pardon me.
Thanks a lot ^^
Screenshot1:
http://i6.photobucket.com/albums/y226/thedark123/screenshot1.gif
Screenshot2:
http://i6.photobucket.com/albums/y226/thedark123/screenshot2new.gif
Screenshot3:
http://i6.photobucket.com/albums/y226/thedark123/screenshot3.gif
Private Sub CommandButton1_Click()
Dim x
' Prompt the user for the folder to list.
x = InputBox("What folder do you want to list?" & Chr$(13) & Chr$(13) _
& "For example: C:\My Documents")
If x = "" Or x = " " Then
Response = MsgBox("Please Enter a Directory Location" _
& Chr$(13) & Chr$(13) & _
"To enter directory location, click No." & Chr$(13) & _
"To Exit, click Yes.", vbYesNo)
If Response = "6" Then
End If
Else
' Search Drive
ChDrive "C"
ChDir x
On Error Resume Next
' Place .xls files into worksheet and tabulate data
outrow = 2
filess = Dir("*.xls")
While Not filess = ""
Workbooks.Open Filename:=filess, UpdateLinks:=False
' requires a reference to the Word Object library:
' in the VBE select Tools, References and check the Microsoft Word X.X object library
Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet
Application.ScreenUpdating = False
Application.StatusBar = "Creating new document..."
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Add
For Each ws In ActiveWorkbook.Worksheets
Application.StatusBar = "Copying data from " & ws.Name & "..."
'ws.UsedRange.Copy ' or edit to the range you want to copy
ws.Range("D3:l8").Copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
Application.CutCopyMode = False
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
' insert page break after all worksheets except the last one
If Not ws.Name = Worksheets(Worksheets.Count).Name Then
With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
End If
Next ws
Set ws = Nothing
Application.StatusBar = "Cleaning up..."
' apply normal view
With wdApp.ActiveWindow
If .View.SplitSpecial = wdPaneNone Then
.ActivePane.View.Type = wdNormalView
Else
.View.Type = wdNormalView
End If
End With
Set wdDoc = Nothing
wdApp.Visible = True
Set wdApp = Nothing
Application.StatusBar = False
filess = Dir()
Wend
End If
End Sub
Problem:
1)The first problem I encountered now is how to format that range of copied cells to the one shown in the screenshot 2,
2)As you can see from screenshot 1, I copied over 5 columns, how to make each column to be in the table format shown in screenshot 2?
In screenshot 3, is the final result I needed can anyone guide me to that way?
If I am not clear in any part of my explanation please pardon me.
Thanks a lot ^^
Screenshot1:
http://i6.photobucket.com/albums/y226/thedark123/screenshot1.gif
Screenshot2:
http://i6.photobucket.com/albums/y226/thedark123/screenshot2new.gif
Screenshot3:
http://i6.photobucket.com/albums/y226/thedark123/screenshot3.gif