PDA

View Full Version : PasteAsNestedTable Error



paddysheeran
05-29-2012, 03:44 AM
Hi All,

i've written a piece of code that copies data from excel into a word template. Eveything works apart from the t.PasteAsNestedTable lines.

here is the code:

Option Explicit
Public Path, SheetName, ChartName, PreviousYear, CurrentYear, Incident_Line As String
Public Templatepath, Report_Date, WordReportTemplate, FileDate, ReportingMonth, ReportingYear, ReportMonth_Number As String
Public Rng, Cell As Range
Public wsSource As Worksheet
Public t As Word.Range 'the new table in Word as a range
Public wdApp As New Word.Application
Public wdDoc As Word.Document 'our new Word document
Public ReportDate As Date
Sub Word_Update()

Application.DisplayAlerts = False

Report_Date = Sheets("Service Report").Range("B8").Text

Templatepath = ThisWorkbook.Path
WordReportTemplate = Templatepath & "\Word_Template.dotx"

Set wdDoc = wdApp.Documents.Add(WordReportTemplate)

DateInput
WR_Title_Page
WR_Footer
WR_Managment_Summary

wdDoc.TablesOfContents(1).UpdatePageNumbers
Set t = wdDoc.Bookmarks("Report_Top").Range
t.Select
Save_Monthly
Sheets("Service Report").Select
ActiveWorkbook.Save
wdApp.Visible = True
Application.DisplayAlerts = True

End Sub
Sub WR_Title_Page()
Set wsSource = ActiveWorkbook.Sheets("Service Report")
Set t = wdDoc.Bookmarks("Report_Date").Range
wdDoc.Bookmarks("Report_Date").Range.Text = Report_Date
wdDoc.Bookmarks("Title_Issue_Number").Range.Text = wsSource.Range("C19").Text
wdDoc.Bookmarks("Title_Issue_Date").Range.Text = wsSource.Range("C20").Text

End Sub
Sub WR_Footer()

wdDoc.Bookmarks("Footer_Issue_No").Range.Text = wsSource.Range("C19").Text
wdDoc.Bookmarks("Footer_Issue_Date").Range.Text = wsSource.Range("C20").Text

End Sub
Sub WR_Managment_Summary()

Set wsSource = ActiveWorkbook.Sheets("Executive Overview")

wdDoc.Bookmarks("MS_ReportDate").Range.Text = Report_Date
wdDoc.Bookmarks("MS_ReportDate2").Range.Text = Report_Date

wdDoc.Bookmarks("MS_LastMonth").Range.Text = wsSource.Range("C6").Text
wdDoc.Bookmarks("MS_ThisMonth").Range.Text = wsSource.Range("D6").Text

Set wsSource = ActiveWorkbook.Sheets("Incident Volumes")

'Incidents logged at the Helpdesk

wdDoc.Bookmarks("MS_LastMonth_Logged").Range.Text = wsSource.Range("C14").Text
wdDoc.Bookmarks("MS_ThisMonth_Logged").Range.Text = wsSource.Range("F14").Text

'Current Month Incidents Logged

wdDoc.Bookmarks("MS_ThisMonth_Logged_P1").Range.Text = wsSource.Range("D19").Text
wdDoc.Bookmarks("MS_ThisMonth_Logged_P2").Range.Text = wsSource.Range("D20").Text
wdDoc.Bookmarks("MS_ThisMonth_Logged_P3").Range.Text = wsSource.Range("D21").Text
wdDoc.Bookmarks("MS_ThisMonth_Logged_P4").Range.Text = wsSource.Range("D22").Text
wdDoc.Bookmarks("MS_ThisMonth_Logged_P5").Range.Text = wsSource.Range("D23").Text

'Last Month SLA Achieved

wdDoc.Bookmarks("MS_LastMonth_SLA_P1").Range.Text = wsSource.Range("H42").Text
wdDoc.Bookmarks("MS_LastMonth_SLA_P2").Range.Text = wsSource.Range("H43").Text
wdDoc.Bookmarks("MS_LastMonth_SLA_P3").Range.Text = wsSource.Range("H44").Text
wdDoc.Bookmarks("MS_LastMonth_SLA_P4").Range.Text = wsSource.Range("H45").Text
wdDoc.Bookmarks("MS_LastMonth_SLA_P5").Range.Text = wsSource.Range("H46").Text

'Current Month SLA Achieved

wdDoc.Bookmarks("MS_ThisMonth_SLA_P1").Range.Text = wsSource.Range("I42").Text
wdDoc.Bookmarks("MS_ThisMonth_SLA_P2").Range.Text = wsSource.Range("I43").Text
wdDoc.Bookmarks("MS_ThisMonth_SLA_P3").Range.Text = wsSource.Range("I44").Text
wdDoc.Bookmarks("MS_ThisMonth_SLA_P4").Range.Text = wsSource.Range("I45").Text
wdDoc.Bookmarks("MS_ThisMonth_SLA_P5").Range.Text = wsSource.Range("I46").Text

'P1 Incidents Logged Detail

Set wsSource = ActiveWorkbook.Sheets("Incident Breakdown")
Set t = wdDoc.Bookmarks("MS_P1_Detail").Range

wsSource.Activate
Columns("B:B").Select

With ActiveSheet
Set Rng = Columns("B:B").Find("P1 & P2 Incidents Logged")
If Rng.Offset(5, 0).Value <> "Nothing to report for this period" Then

Range(Rng.Offset(4, 0), Rng.Offset(4, 0).End(xlDown)).Select
Set Rng = Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1)
For Each Cell In Rng

Incident_Line = Range("B8").Text & ": " & Cell.Text & vbCr _
& Range("D8").Text & ": " & Cell.Offset(0, 2).Text & vbCr _
& "Description" & ": " & vbCr & "Resolution:" & " " & vbCr & vbCr

wdDoc.Bookmarks("MS_P1_Detail").Range.Text = Incident_Line

Next Cell

Else

wdDoc.Bookmarks("MS_ThisMonth_SLA_P1").Range.Text = "Nothing to report for this period"
End If
End With


'P2 Incidents Logged Detail




'P3 Incidents Open

Set wsSource = ActiveWorkbook.Sheets("Executive Overview")

wsSource.Activate

wdDoc.Bookmarks("MS_P3_Open").Range.Text = wsSource.Range("B22").Text

'P3 Open Items

Set t = wdDoc.Bookmarks("MS_P3_Open_Detail").Range
If wsSource.Range("C17").Value > 0 Then
Range("B28").CurrentRegion.Copy
t.PasteAsNestedTable
Open_Formatt
Application.CutCopyMode = False
Else
End If

'P4 Incidents Open
'P4 Open Text

wdDoc.Bookmarks("MS_P4_Open").Range.Text = wsSource.Range("G22").Text

'P4 Open Items

Set t = wdDoc.Bookmarks("MS_P4_Open_Detail").Range
If wsSource.Range("C18").Value > 0 Then
Range("G28").CurrentRegion.Copy
wdDoc.Activate
t.PasteAsNestedTable
Open_Formatt
Application.CutCopyMode = False
Else
End If

'P5 Incidents Open

'P5 Open Text

wdDoc.Bookmarks("MS_P5_Open").Range.Text = wsSource.Range("K22").Text

'P4 Open Items

Set t = wdDoc.Bookmarks("MS_P5_Open_Detail").Range
If wsSource.Range("C19").Value > 0 Then
Range("K28").CurrentRegion.Copy
wdDoc.Activate
t.Select
t.PasteAsNestedTable
Open_Formatt
Application.CutCopyMode = False
Else
End If


End Sub
Sub Open_Formatt()

With t
.Font.Size = "8"
.Tables(1).Rows(1).HeadingFormat = True
.Tables(1).Rows.AllowBreakAcrossPages = False
.Tables(1).Columns(1).SetWidth ColumnWidth:=160, RulerStyle:= _
wdAdjustNone
.Tables(1).Columns(2).SetWidth ColumnWidth:=36, RulerStyle:= _
wdAdjustNone
End With

Padding_F

End Sub

Sub Padding_F()
With t
.Tables(1).TopPadding = InchesToPoints(0.02)
.Tables(1).BottomPadding = InchesToPoints(0.02)
.Tables(1).LeftPadding = InchesToPoints(0.02)
.Tables(1).RightPadding = InchesToPoints(0.02)
End With
End Sub








When the code line "t.PasteAsNestedTable" is run I get the error message:

Run-Time error '4605':
Method 'PasteAsNestedTable' of object 'Range' failed

Once I debug and press continue the code runs until the next entry of "t.PasteAsNestedTable" when i have to debug and press continue again.

Is there any way i can alter the code so that i dont have to debug and continue in order to force the code along?

many thanks in adance.

Paddy.

Frosty
05-29-2012, 11:42 AM
Couple of issues, Paddy:

1) It does not appear to me that you can select a range of excel cells and then use .PasteAsNestedTable ... although you can use .Paste. So you may need to re-think this process.

2) I think you need to see if you can get away from all of your use of Selection (in both Word and Excel). That will also get rid of your need for .Activate.

3) Yes, you can alter the code so that you don't have to debug... just remove that line of code. But since you presumably want it to do something (since it's there in the first place), maybe you could better describe what you want to happen? Why did you want to use .PasteAsNestedTable? Does .Paste not work? If not, why not?

Basically -- since you can't directly paste an Excel range as a nested table, you have to decide what you want to do. You could probably paste it as a separate table, then copy that table, and since it's now a word table... you could then .Cut that table and simply use the .PasteAsNestedTable method on that... but it's tough to give guidance without more information.

Here's a demo... select a range of cells in Excel, copy it... and then in Word, put your selection in a table, and then run the below code.

There are many approaches, but I'm not sure what you want the end result to be. This is just a demo.

Sub Demo()
Dim oTempDoc As Document
Dim rngCopy As Range
Dim rngOrig As Range

Set rngOrig = Selection.Range.Duplicate

Set oTempDoc = Documents.Add
oTempDoc.Content.Paste
Set rngCopy = oTempDoc.Tables(1).Range
rngCopy.Copy

rngOrig.PasteAsNestedTable
oTempDoc.Saved = True
oTempDoc.Close
End Sub