white_flag
08-24-2011, 04:14 AM
Hello
I have an excel file that will create an doc file. Will copy some rows from excel and pasted as tabke in an new document created. this is my code:
What I can not do it is to change the font.name , and the rest from the font, size, bold etc ...
code for change the font size, etc ...
For i = 1 To wdDoc.Tables.Count
wdDoc.Tables(i).Select
With Selection
.Font.Bold = True
.Font.Italic = False
.Font.Name = "Arial"
.Font.Size = "20"
End With
Next i
entire code
Option Explicit
Sub CopyWorksheetsToWord()
Dim OFile As String
Dim filetoopen As String
Dim WeDone As Long
Dim tableTemp As Table
Dim rngTemp As Range
Dim i As Long
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim ws As Worksheet
With Application
.ScreenUpdating = False
.StatusBar = "Creating new document..."
End With
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Add
'Save for closing
OFile = ActiveWorkbook.Name
For Each ws In ActiveWorkbook.Worksheets
ws.Range("B1").Copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
ws.Range("A25:K45").Copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
Application.CutCopyMode = False
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
wdApp.Visible = True
For i = 1 To wdDoc.Tables.Count
wdDoc.Tables(i).Select
With Selection
.Font.Bold = True
.Font.Italic = False
.Font.Name = "Arial"
.Font.Size = "20"
End With
Next i
For i = 1 To wdDoc.Tables.Count
wdDoc.Tables(i).AutoFitBehavior wdAutoFitWindow
Next i
For i = 1 To wdDoc.Tables.Count
wdDoc.Tables(i).ConvertToText Separator:=wdSeparateByTabs, NestedTables:=True
On Error Resume Next
Next i
If ActiveWorkbook.Name <> OFile Then
ActiveWorkbook.Close False
End If
' apply normal view
With wdApp.ActiveWindow
If .View.SplitSpecial = wdPaneNone Then
.ActivePane.View.Type = wdPrintView
Else
.View.Type = wdPrintView
End If
End With
wdApp.Visible = True
Set wdDoc = Nothing
Set wdApp = Nothing
Set tableTemp = Nothing
Set rngTemp = Nothing
Set ws = Nothing
'Reset
With Application
.StatusBar = False
.ScreenUpdating = True
End With
End Sub
any ideea?
I have an excel file that will create an doc file. Will copy some rows from excel and pasted as tabke in an new document created. this is my code:
What I can not do it is to change the font.name , and the rest from the font, size, bold etc ...
code for change the font size, etc ...
For i = 1 To wdDoc.Tables.Count
wdDoc.Tables(i).Select
With Selection
.Font.Bold = True
.Font.Italic = False
.Font.Name = "Arial"
.Font.Size = "20"
End With
Next i
entire code
Option Explicit
Sub CopyWorksheetsToWord()
Dim OFile As String
Dim filetoopen As String
Dim WeDone As Long
Dim tableTemp As Table
Dim rngTemp As Range
Dim i As Long
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim ws As Worksheet
With Application
.ScreenUpdating = False
.StatusBar = "Creating new document..."
End With
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Add
'Save for closing
OFile = ActiveWorkbook.Name
For Each ws In ActiveWorkbook.Worksheets
ws.Range("B1").Copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
ws.Range("A25:K45").Copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
Application.CutCopyMode = False
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
wdApp.Visible = True
For i = 1 To wdDoc.Tables.Count
wdDoc.Tables(i).Select
With Selection
.Font.Bold = True
.Font.Italic = False
.Font.Name = "Arial"
.Font.Size = "20"
End With
Next i
For i = 1 To wdDoc.Tables.Count
wdDoc.Tables(i).AutoFitBehavior wdAutoFitWindow
Next i
For i = 1 To wdDoc.Tables.Count
wdDoc.Tables(i).ConvertToText Separator:=wdSeparateByTabs, NestedTables:=True
On Error Resume Next
Next i
If ActiveWorkbook.Name <> OFile Then
ActiveWorkbook.Close False
End If
' apply normal view
With wdApp.ActiveWindow
If .View.SplitSpecial = wdPaneNone Then
.ActivePane.View.Type = wdPrintView
Else
.View.Type = wdPrintView
End If
End With
wdApp.Visible = True
Set wdDoc = Nothing
Set wdApp = Nothing
Set tableTemp = Nothing
Set rngTemp = Nothing
Set ws = Nothing
'Reset
With Application
.StatusBar = False
.ScreenUpdating = True
End With
End Sub
any ideea?