- 09 Abr 2017 às 18:44
#22174
O código ainda não está terminado, pois a ideia é fazer um loop ao longo das informações preenchidas na tabela e criar um arquivo word para cada nome. Entretanto, já vislumbro o problema, uma vez que quando tento rodar o código novamente o erro 462 é apontado. Alguma luz? Agradeço desde já...Segue o código:
Private Sub btn_montar_contrato_Click()
Dim WdApp As Word.Application
Dim wdDOC As Word.Document
Dim rng As Word.Range
Set wdDOC = Nothing
On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If Err.Number > 0 Then
Set WdApp = CreateObject("Word.Application")
On Error GoTo 0
End If
WdApp.DisplayAlerts = False
WdApp.Visible = True
Set wdDOC = Word.Documents.Open("C:\Users\paulo\Desktop\teste\modelo_recisao.docx")
With wdDOC
'*Dados locador
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#nome"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("d3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#datainic"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("h3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#datarec"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("k3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#horario"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("l3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#nivel"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("m3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#faculdade"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("n3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#datafim"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("k3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#unidade"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("c3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#curso"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("q3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#horas"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("t3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#hext"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("z3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True '
.Application.Selection.Find.Text = "#datarec"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("w3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#supervisor"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("v3"), wdReplaceAll
wdDOC.SaveAs ("C:\Users\paulo\Desktop\teste\" & Range("d3").Value & "_RECISAO.docx")
wdDOC.Close
End With
wdDOC.DisplayAlerts = True
WdApp.Quit acQuitSaveNone
Set wdDOC = Nothing
Set WdApp = Nothing
End Sub
Private Sub btn_montar_contrato_Click()
Dim WdApp As Word.Application
Dim wdDOC As Word.Document
Dim rng As Word.Range
Set wdDOC = Nothing
On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If Err.Number > 0 Then
Set WdApp = CreateObject("Word.Application")
On Error GoTo 0
End If
WdApp.DisplayAlerts = False
WdApp.Visible = True
Set wdDOC = Word.Documents.Open("C:\Users\paulo\Desktop\teste\modelo_recisao.docx")
With wdDOC
'*Dados locador
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#nome"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("d3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#datainic"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("h3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#datarec"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("k3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#horario"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("l3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#nivel"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("m3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#faculdade"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("n3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#datafim"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("k3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#unidade"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("c3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#curso"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("q3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#horas"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("t3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#hext"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("z3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True '
.Application.Selection.Find.Text = "#datarec"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("w3"), wdReplaceAll
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#supervisor"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("v3"), wdReplaceAll
wdDOC.SaveAs ("C:\Users\paulo\Desktop\teste\" & Range("d3").Value & "_RECISAO.docx")
wdDOC.Close
End With
wdDOC.DisplayAlerts = True
WdApp.Quit acQuitSaveNone
Set wdDOC = Nothing
Set WdApp = Nothing
End Sub