PDA

View Full Version : Runtime error 462



NunoGoncalve
07-08-2014, 07:09 AM
Hi,
I tried several ways to fix my code but it's always give me the same error (runtime error 462) and highlight this piece of code:

WDoc.Paragraphs(cenas).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _ ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior

I googled for a resolution but i canīt fix it.

My code is:

Public inicio As Integer, numero_step As Integer, linha_final As Integer
Public posicao_linha As Integer, cenas As Integer
Public WBname As String, nome_do_ficheiro As String
Public fname As String, texto As String
Public BlnWordAppOpen As Boolean
Public WDoc As Object


Sub main()


inicio = 5
posicao_linha = inicio
nome_do_ficheiro = 1
cenas = 14
linha_final = fimdoexcel

createdir


Do While posicao_linha <= linha_final

If posicao_linha = linha_final + 1 Then
Exit Do
End If


Print_case
Loop

End Sub


Sub createdir()


Dim Path As String, Path1 As String


workbook_name = ThisWorkbook.Name
WBname = Replace(workbook_name, ".xlsm", "")
WBname = Replace(WBname, ".xls", "")




Path = "C:\Users\ex52852\Desktop\Evidencias"
Path1 = "C:\Users\ex52852\Desktop\Evidencias\" & WBname


If Len(Dir(Path, vbDirectory)) = 0 Then
MkDir (Path)
End If


If Len(Dir(Path1, vbDirectory)) = 0 Then
MkDir (Path1)
End If


End Sub




Function fimdoexcel() As Integer


ActiveCell.SpecialCells(xlLastCell).Select
fimdoexcel = ActiveCell.Row
Range("A1").Select


End Function








Sub Print_case()
Dim WDoc As Object


Set WDoc = New Word.Application

numero_step = 1

Set WDoc = GetObject(, "Word.Application")
WDoc.Visible = True
Set WDoc = WDoc.Documents.Open("C:\temp\template.docx")




Set objTable = WDoc.Tables(1)

If Len(Range("I" & posicao_linha)) < 3 Then
aux = "0" & Range("I" & posicao_linha)
nome_do_ficheiro = aux
Else
aux = Range("I" & posicao_linha)
nome_do_ficheiro = aux
End If

workbook_name = ThisWorkbook.Name
WBname = Replace(workbook_name, ".xlsm", "")
WBname = Replace(WBname, ".xls", "")


With objTable
.Cell(1, 2).Range.Text = "CRM - " & WBname & " - " & ActiveSheet.Name
.Cell(2, 2).Range.Text = "CT" & aux & " - " & Range("J" & posicao_linha)
End With


WDoc.Content.InsertParagraphAfter

WDoc.Content.InsertAfter "Step # " & numero_step & " : " & Range("Q5")

numero_step = numero_step + 1
posicao_linha = posicao_linha + 1

WDoc.Content.InsertParagraphAfter
WDoc.Content.InsertParagraphAfter

Do While Range("J" & posicao_linha) = "" And Range("Q" & posicao_linha) <> ""

WDoc.Content.InsertAfter "Step # " & numero_step & " : " & Range("Q" & posicao_linha)
WDoc.Content.InsertParagraphAfter
WDoc.Content.InsertParagraphAfter

numero_step = numero_step + 1
posicao_linha = posicao_linha + 1


WDoc.Paragraphs(cenas).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior

cenas = cenas + 2


Loop



WDoc.Content.Paragraphs(cenas).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior


WDoc.Content.InsertParagraphAfter


Dim numRows As Long, numCols As Long


numRows = 2
numCols = 2
Set wordrange = WDoc.Range(WDoc.Range.Characters.Count - 1)
Set wordTable = wordrange.Tables.Add(wordrange, numRows, _
numCols, wdWord9TableBehavior, wdAutoFitContent)




WDoc.Tables(2).Cell(1, 1).Range.Text = "Status:"
WDoc.Tables(2).Cell(2, 1).Range.Text = "Comments:"

WDoc.Tables(2).Borders.Enable = True
WDoc.Tables(2).Cell(1, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
WDoc.Tables(2).Cell(2, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
WDoc.Tables(2).Cell(1, 1).Width = 71
WDoc.Tables(2).Cell(2, 1).Width = 71
WDoc.Tables(2).Cell(1, 2).Width = 430
WDoc.Tables(2).Cell(2, 2).Width = 430


Set WDoc = GetObject(, "Word.Application")
fname = "CT" & nome_do_ficheiro & "_Evidęncias"




If fname <> "" Then 'make sure fname is not blank
WDoc.ChangeFileOpenDirectory "C:\Users\ex52852\Desktop\Evidencias\" & WBname & "\" 'save Dir
WDoc.ActiveDocument.SaveAs Filename:=fname & ".doc"
Else:
MsgBox ("File not saved, naming range was botched, guess again.")
End If


'With WDoc
'.ActiveDocument.Close
'.Quit
'End With


'WDoc.apllication.Quit


Set objTable = Nothing
Set wordrange = Nothing
Set wordTable = Nothing
Set WDoc = Nothing
Set WordObj = Nothing
Set wordparagraphs = Nothing


End Sub


Please help me!
Thxs

snb
07-08-2014, 08:14 AM
Please use code tags !!