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
Reply With Quote