PDA

View Full Version : Solved: copy from excel to word



white_flag
12-15-2011, 03:44 AM
Good morning

The following code does (try to do) the followings: create an word doc, select an range from excel, copy, paste as table in the new created doc document,save, close.
it is doing what I am expected. Except this: check the table in doc and if an cell from column 2 is empty to delete entire row:

the code for deleting the row is this (but it is not working):


For i = 1 To wdDoc.Tables.Count
wdDoc.Tables(i).Select
wdDoc.Tables(i).AutoFitBehavior wdAutoFitWindow
With wdDoc.Tables(i).Range
.Font.Name = "Trebuchet MS"
End With
With wdDoc.Tables(i)
.Select
For j = .Rows.Count To 1 Step -1
If Len(.Cell(j, 2).Range.Text) = 2 Then
.Rows(j).Delete
End If
Next j
End With
Next i



the rest of the code:


Sub CopyWorksheetsToWord()

' requires a reference To the Word Object library:
' in the VBE select Tools, References and check the Microsoft Word X.X object library

Dim OFile As String
Dim filetoopen As String, fnd
Dim WeDone As Long
Dim tableTemp As Table
Dim rngTemp As Range
Dim i As Long, j, c
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim ws As Worksheet

Dim mydoc As String

On Error GoTo Err2:
Calculation:

mydoc = ThisWorkbook.Path & "\tabel.doc"



Set wdDoc = GetObject(mydoc)

With ws

With ThisWorkbook.Worksheets("Calculation")
'.Range(.Cells(12, 1), .Cells.SpecialCells(xlCellTypeLastCell)).Copy
.Range("A12:T" & Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 3).Copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
End With
Application.CutCopyMode = False
With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
End With
wdDoc.UndoClear
For i = 1 To wdDoc.Tables.Count
wdDoc.Tables(i).Select
wdDoc.Tables(i).AutoFitBehavior wdAutoFitWindow
With wdDoc.Tables(i).Range
.Font.Name = "Trebuchet MS"
End With
With wdDoc.Tables(i)
.Select
For j = .Rows.Count To 1 Step -1
If Len(.Cell(j, 2).Range.Text) = 2 Then
.Rows(j).Delete
End If
Next j
End With
Next i
With wdDoc.Tables(wdDoc.Tables.Count)
.Columns(3).Delete
.Columns(3).Delete
.Columns(4).Delete
.Columns(4).Delete
End With

wdDoc.Tables(wdDoc.Tables.Count).AutoFitBehavior wdAutoFitWindow
wdDoc.SaveAs Filename:=ThisWorkbook.Path & "\tabel"


'Reset
With Application
.StatusBar = False
.ScreenUpdating = True
End With


Set wdDoc = Nothing
Set wdApp = Nothing
Set tableTemp = Nothing
Set rngTemp = Nothing
Set ws = Nothing



OFile = ActiveWorkbook.Name
Exit Sub

Err2:
If Err.Number <> 0 Then
Select Case Err.Number
Case 432
With Application
.ScreenUpdating = False
.StatusBar = "Creating new document..."
End With
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Add
'wdApp.Visible = True
wdDoc.SaveAs ThisWorkbook.Path & "\tabel"
GoTo Calculation:
Case Else
MsgBox Err.Number
End Select
End If

End Sub

I change condition in this one: (but nothing)


If Len(.Cell(j, 2).Range.Text) = Null Then ---- Null=Null (TRUE)
.Rows(j).Delete --- it is skiping this
End If

Simon Lloyd
12-15-2011, 10:54 AM
I haven't looked at the rest of your code but i believe that thisRows(j).Delete
should beRows(j).EntireRow.Delete

Dave
12-15-2011, 01:06 PM
Also posted on Mr. Excel. Dave

Simon Lloyd
12-16-2011, 12:19 AM
Thanks Dave!
@ White_Flag, you are not a new user and are well aware about almost every forums rules on cross posting, you should supply a link to EVERY crosspost!

Read this: http://www.excelguru.ca/node/7

white_flag
12-16-2011, 02:09 AM
mia culpa

(http://%3Cbr%20/%3E%0Ahttp://www.mrexcel.com/forum/showthread.php?p=2966127#post2966127%3Cbr%20/%3E)http://www.mrexcel.com/forum/showthread.php?p=2966127#post2966127
(http://%3Cbr%20/%3E%0Ahttp://www.mrexcel.com/forum/showthread.php?p=2966127#post2966127%3Cbr%20/%3E)

still the code it is skipping this part if the condition is TRUE (why?):

Rows(j).EntireRow.Delete
.Rows(j).Delete

white_flag
12-16-2011, 02:43 AM
I solved like this:


With wdDoc.Tables(i)
.Select
For j = .Rows.Count To 1 Step -1
If Len(.Cell(j, 2).Range.Text) = 3 Then ' here it is 3 not 2
.Rows(j).Delete
End If
Next j
End With