perola.rike
Board Regular
- Joined
- Nov 10, 2011
- Messages
- 151
I have a Workbook that generates a Word report. It work fine except I cannot figure out how to write a code in my Excel module that executes the "Remove Space after Paragraph" in the Word document ...
Any solutions?
This is the code:
Sub wordexport()
'PART 1 EXCEL
Dim i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Sheets("wordexport").Range("A1:A500").ClearContents
Sheets("wordgenerator").Range("$C$1:$C$229").AutoFilter Field:=1, Criteria1:="<>" 'skjuler blanke rader
Sheets("wordgenerator").Select
Range("D1:D180").Select
Selection.Copy
Sheets("wordexport").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
'PART 2 WORD
Dim wdApp As Object
Dim wd As Object
Dim myCells As Range
On Error Resume Next
Dim rng As Range
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wd = wdApp.Documents.Add
wdApp.Visible = True
Set rng = Sheets("wordexport").Range("A1:A300")
rng.Copy
With wd.Range
.Collapse Direction:=0
.Collapse Direction:=0
.PasteSpecial False, False, True
.tables(1).Select
wd.tables(1).ConvertToText Separator:=0, NestedTables:=True
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Any solutions?
This is the code:
Sub wordexport()
'PART 1 EXCEL
Dim i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Sheets("wordexport").Range("A1:A500").ClearContents
Sheets("wordgenerator").Range("$C$1:$C$229").AutoFilter Field:=1, Criteria1:="<>" 'skjuler blanke rader
Sheets("wordgenerator").Select
Range("D1:D180").Select
Selection.Copy
Sheets("wordexport").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
'PART 2 WORD
Dim wdApp As Object
Dim wd As Object
Dim myCells As Range
On Error Resume Next
Dim rng As Range
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wd = wdApp.Documents.Add
wdApp.Visible = True
Set rng = Sheets("wordexport").Range("A1:A300")
rng.Copy
With wd.Range
.Collapse Direction:=0
.Collapse Direction:=0
.PasteSpecial False, False, True
.tables(1).Select
wd.tables(1).ConvertToText Separator:=0, NestedTables:=True
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub