Guru do Excel e Power BI

Fórum de Dúvidas sobre Excel e Power BI
https://gurudoexcel.com/

Erro 462, não sei o que fazer!

https://gurudoexcel.com/viewtopic.php?t=3165

Página 1 de 1

Erro 462, não sei o que fazer!

Enviado: 29 Set 2016 às 12:06
por victormonfort
Boa tarde !

Estou em fase final do meu projeto em VBA, graças aos usuários do forum que tiraram algumas dúvidas e muito tempo de pesquisa e testes.

Tudo funciona perfeitamente, na 1x que eu clico no botão. Se eu altero alguma coisa no form e clico de novo, da o erro 462 (A máquina do servidor remoto não existe ou está indisponível).

É altamente necessário que eu apenas clique de novo no botão, e não preencha tudo novamente porque é muita coisa e a variação de um pro outro é mínima, então com o form preenchido do relatório anterior poupa um enorme tempo!

Encontrei soluções para esse erro, inclusive no site da microsoft, mas não sei como aplicar ao meu código. Vi também que esse erro acontece em VÁRIAS partes do código, porque eu removia a parte que estava com o erro e depois aparecia em outra parte, etc.
Código: Selecionar todos
'Auto Preenchimento - Botão
Private Sub CommandButton2_Click()

txt_cloro.Text = Range("b2")
txt_cor.Text = Range("b3")
txt_ct.Text = Range("b4")
txt_ec.Text = Range("b5")
txt_nre.Text = Range("b6")
txt_lqa.Text = Range("b7")
txt_lemi.Text = Range("b8")
txt_datare.Text = Range("b9")
txt_dataco.Text = Range("b10")
txt_datareceb.Text = Range("b11")
txt_oslqa.Text = Range("b12")
txt_oslemi.Text = Range("b13")


End Sub

'Máscaras de texto e emulação de TAB
Private Sub txt_dataco_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_dataco.MaxLength = 10
 Select Case KeyAscii
      Case 8
      Case 13: SendKeys "{TAB}"
      Case 48 To 57
         If txt_dataco.SelStart = 2 Then txt_dataco.SelText = "/"
         If txt_dataco.SelStart = 5 Then txt_dataco.SelText = "/"
         If txt_dataco.SelStart = 9 Then SendKeys "{TAB}"
      Case Else: KeyAscii = 0
   End Select

End Sub

Private Sub txt_datareceb_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_datareceb.MaxLength = 10
 Select Case KeyAscii
      Case 8
      Case 13: SendKeys "{TAB}"
      Case 48 To 57
         If txt_datareceb.SelStart = 2 Then txt_datareceb.SelText = "/"
         If txt_datareceb.SelStart = 5 Then txt_datareceb.SelText = "/"
         If txt_datareceb.SelStart = 9 Then SendKeys "{TAB}"
      Case Else: KeyAscii = 0
   End Select

End Sub

Private Sub txt_horacoleta_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_horacoleta.MaxLength = 5
 Select Case KeyAscii
      Case 8
      Case 13: SendKeys "{TAB}"
      Case 48 To 57
         If txt_horacoleta.SelStart = 2 Then txt_horacoleta.SelText = ":"
         If txt_horacoleta.SelStart = 4 Then SendKeys "{TAB}"
      Case Else: KeyAscii = 0
   End Select

End Sub

Private Sub txt_lemi_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_lemi.MaxLength = 4
 Select Case KeyAscii
      Case 8
      Case 13: SendKeys "{TAB}"
      Case 48 To 57
         If txt_lemi.SelStart = 3 Then SendKeys "{TAB}"
      Case Else: KeyAscii = 0
   End Select

End Sub

Private Sub txt_lqa_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_lqa.MaxLength = 5
 Select Case KeyAscii
      Case 8
      Case 13: SendKeys "{TAB}"
      Case 48 To 57
         If txt_lqa.SelStart = 4 Then SendKeys "{TAB}"
      Case Else: KeyAscii = 0
   End Select

End Sub

'Código do ComboBox1 das ETAS
Private Sub UserForm_Initialize()
     lin = 2
    Do Until Plan1.Cells(lin, 1) = ""
         ComboBox1.AddItem Plan1.Cells(lin, 1)
         lin = lin + 1
     Loop
End Sub

Private Sub CommandButton1_Click()

    Dim Word As Word.Application
    Dim DOC As Word.Document
    
    Set Word = CreateObject("Word.Application")
    Word.Visible = True
    
    Set DOC = Word.Documents.Open("C:\Users\Victor Monfort\Downloads\Excel (1)\Excel\contrato_modelo2.docx")
    
    With DOC
        '*Dados Amostra
        .Application.Selection.Find.Text = "#NRE"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_nre
        
        .Application.Selection.Find.Text = "#DATARE"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_datare
        
        .Application.Selection.Find.Text = "#NOMEETA"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = ComboBox1
        
        .Application.Selection.Find.Text = "#DCA"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_dataco
        
        .Application.Selection.Find.Text = "#HORACOLETA"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_horacoleta
        
        .Application.Selection.Find.Text = "#DRA"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_datareceb
        
        .Application.Selection.Find.Text = "#COR"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cor
        
        .Application.Selection.Find.Text = "#TURB"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_turb
        
        .Application.Selection.Find.Text = "#CT"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_ct
        
        .Application.Selection.Find.Text = "#EC"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_ec
        
        .Application.Selection.Find.Text = "#CLORO"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cloro
        
        .Application.Selection.Find.Text = "#NRE2"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_nre
       

'Código para substituir no rodapé
Dim oSection As Word.Section
Dim oRange As Word.Range
Dim var

For Each oSection In ActiveDocument.Sections()
For var = 1 To 3
Set oRange = oSection.Footers(var).Range
oRange.Find.Execute FindText:="#NLQA", _
ReplaceWith:=txt_lqa, Replace:=wdReplaceAll
Set oRange = Nothing
Next
Next

For Each oSection In ActiveDocument.Sections()
For var = 1 To 3
Set oRange = oSection.Footers(var).Range
oRange.Find.Execute FindText:="#OSLQA", _
ReplaceWith:=txt_oslqa, Replace:=wdReplaceAll
Set oRange = Nothing
Next
Next

For Each oSection In ActiveDocument.Sections()
For var = 1 To 3
Set oRange = oSection.Footers(var).Range
oRange.Find.Execute FindText:="#NLEMI", _
ReplaceWith:=txt_lemi, Replace:=wdReplaceAll
Set oRange = Nothing
Next
Next

For Each oSection In ActiveDocument.Sections()
For var = 1 To 3
Set oRange = oSection.Footers(var).Range
oRange.Find.Execute FindText:="#OSLEMI", _
ReplaceWith:=txt_oslemi, Replace:=wdReplaceAll
Set oRange = Nothing
Next
Next


'Código para gerar o nome do arquivo
Dim FNam1 As String
Dim FNam2 As String
Dim FNam3 As String
Dim FNam4 As String
Dim FNam5 As String
Dim FNam6 As String
Dim FNam7 As String
Dim FName As String

FNam1 = "RE"
FNam2 = txt_nre
FNam3 = "COMPESA - LQA"
FNam4 = txt_lqa
FNam5 = "LEMI"
FNam6 = txt_lemi
FNam7 = "-2016.docx"

FName = FNam1 + Space(1) + FNam2 + Space(1) + FNam3 + Space(1) + FNam4 + Space(1) + FNam5 + Space(1) + FNam6 + FNam7

'Código para salvar arquivo Word
ChangeFileOpenDirectory "C:\Users\Victor Monfort\Desktop\"
    ActiveDocument.SaveAs Filename:=FName, FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
End With
End Sub
Se alguém puder editar o código para que remova esse esse, eu agradeço muito!

Muito obrigado, abraço.

Re: Erro 462, não sei o que fazer!

Enviado: 29 Set 2016 às 12:44
por alexandrevba
Boa tarde!!

Primeiro eu gostaria que você verificasse não há referências marcas como ausente.

Dentro do EditorVB (Alt + F11), Ferramenta -> Referências, olhe com atenção para ver se não alguma referencia marcada como ausente.
Caso encontrar, desmarque!

Att

Re: Erro 462, não sei o que fazer!

Enviado: 29 Set 2016 às 16:03
por Reinaldo
aparentemente o erro ocorre pois o objeto ainda esta "ativo"
Experimente fechar o objeto e "descarregar" as variáveis.
Código: Selecionar todos
ChangeFileOpenDirectory "C:\Users\Victor Monfort\Desktop\"
    ActiveDocument.SaveAs Filename:=FName, FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
End With
Word.Quit
Word = Nothing
DOC = Nothing
oSection = Nothing
oRange = Nothing
End Sub

Re: Erro 462, não sei o que fazer!

Enviado: 29 Set 2016 às 22:06
por victormonfort
alexandrevba escreveu:Boa tarde!!

Primeiro eu gostaria que você verificasse não há referências marcas como ausente.

Dentro do EditorVB (Alt + F11), Ferramenta -> Referências, olhe com atenção para ver se não alguma referencia marcada como ausente.
Caso encontrar, desmarque!

Att
Não tem nenhuma referência como ausente

Re: Erro 462, não sei o que fazer!

Enviado: 29 Set 2016 às 22:08
por victormonfort
Reinaldo escreveu:aparentemente o erro ocorre pois o objeto ainda esta "ativo"
Experimente fechar o objeto e "descarregar" as variáveis.
Código: Selecionar todos
ChangeFileOpenDirectory "C:\Users\Victor Monfort\Desktop\"
    ActiveDocument.SaveAs Filename:=FName, FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
End With
Word.Quit
Word = Nothing
DOC = Nothing
oSection = Nothing
oRange = Nothing
End Sub
Ocorreu este erro:

Imagem

Erro 462, não sei o que fazer!

Enviado: 04 Out 2016 às 00:51
por victormonfort
Alguém pode ajudar?

Re: Erro 462, não sei o que fazer!

Enviado: 06 Out 2016 às 00:24
por victormonfort
Consegui apos dias de pesquisa!

Vou deixar o código para quem precisar.

Mudei ActiveDocument para a variável DOC e mudei também a parte de salvar para algo mais simples.
Código: Selecionar todos
'Auto Preenchimento - Botão
Private Sub CommandButton2_Click()

txt_cloro.Text = Range("b2")
txt_cor.Text = Range("b3")
txt_ct.Text = Range("b4")
txt_ec.Text = Range("b5")
txt_nre.Text = Range("b6")
txt_lqa.Text = Range("b7")
txt_lemi.Text = Range("b8")
txt_datare.Text = Range("b9")
txt_dataco.Text = Range("b10")
txt_datareceb.Text = Range("b11")
txt_oslqa.Text = Range("b12")
txt_oslemi.Text = Range("b13")


End Sub

'Máscaras de texto e emulação de TAB
Private Sub txt_dataco_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_dataco.MaxLength = 10
 Select Case KeyAscii
      Case 8
      Case 13: SendKeys "{TAB}"
      Case 48 To 57
         If txt_dataco.SelStart = 2 Then txt_dataco.SelText = "/"
         If txt_dataco.SelStart = 5 Then txt_dataco.SelText = "/"
         If txt_dataco.SelStart = 9 Then SendKeys "{TAB}"
      Case Else: KeyAscii = 0
   End Select

End Sub

Private Sub txt_datareceb_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_datareceb.MaxLength = 10
 Select Case KeyAscii
      Case 8
      Case 13: SendKeys "{TAB}"
      Case 48 To 57
         If txt_datareceb.SelStart = 2 Then txt_datareceb.SelText = "/"
         If txt_datareceb.SelStart = 5 Then txt_datareceb.SelText = "/"
         If txt_datareceb.SelStart = 9 Then SendKeys "{TAB}"
      Case Else: KeyAscii = 0
   End Select

End Sub

Private Sub txt_horacoleta_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_horacoleta.MaxLength = 5
 Select Case KeyAscii
      Case 8
      Case 13: SendKeys "{TAB}"
      Case 48 To 57
         If txt_horacoleta.SelStart = 2 Then txt_horacoleta.SelText = ":"
         If txt_horacoleta.SelStart = 4 Then SendKeys "{TAB}"
      Case Else: KeyAscii = 0
   End Select

End Sub

Private Sub txt_lemi_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_lemi.MaxLength = 4
 Select Case KeyAscii
      Case 8
      Case 13: SendKeys "{TAB}"
      Case 48 To 57
         If txt_lemi.SelStart = 3 Then SendKeys "{TAB}"
      Case Else: KeyAscii = 0
   End Select

End Sub

Private Sub txt_lqa_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_lqa.MaxLength = 5
 Select Case KeyAscii
      Case 8
      Case 13: SendKeys "{TAB}"
      Case 48 To 57
         If txt_lqa.SelStart = 4 Then SendKeys "{TAB}"
      Case Else: KeyAscii = 0
   End Select

End Sub

'Código do ComboBox1 das ETAS
Private Sub UserForm_Initialize()
     lin = 2
    Do Until Plan1.Cells(lin, 1) = ""
         ComboBox1.AddItem Plan1.Cells(lin, 1)
         lin = lin + 1
     Loop
End Sub

Private Sub CommandButton1_Click()

    Dim Word As Word.Application
    Dim DOC As Word.Document
    
    Set Word = CreateObject("Word.Application")
    Word.Visible = True
    
    Set DOC = Word.Documents.Open("C:\Users\Victor Monfort\Downloads\Excel (1)\Excel\contrato_modelo2.docx")
    
    With DOC
        '*Dados Amostra
        .Application.Selection.Find.Text = "#NRE"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_nre
        
        .Application.Selection.Find.Text = "#DATARE"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_datare
        
        .Application.Selection.Find.Text = "#NOMEETA"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = ComboBox1
        
        .Application.Selection.Find.Text = "#DCA"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_dataco
        
        .Application.Selection.Find.Text = "#HORACOLETA"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_horacoleta
        
        .Application.Selection.Find.Text = "#DRA"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_datareceb
        
        .Application.Selection.Find.Text = "#COR"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cor
        
        .Application.Selection.Find.Text = "#TURB"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_turb
        
        .Application.Selection.Find.Text = "#CT"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_ct
        
        .Application.Selection.Find.Text = "#EC"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_ec
        
        .Application.Selection.Find.Text = "#CLORO"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cloro
        
        .Application.Selection.Find.Text = "#NRE2"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_nre
       

'Código para substituir no rodapé
Dim oSection As Word.Section
Dim oRange As Word.Range
Dim var

For Each oSection In DOC.Sections()
For var = 1 To 3
Set oRange = oSection.Footers(var).Range
oRange.Find.Execute FindText:="#NLQA", _
ReplaceWith:=txt_lqa, Replace:=wdReplaceAll
Set oRange = Nothing
Next
Next

For Each oSection In DOC.Sections()
For var = 1 To 3
Set oRange = oSection.Footers(var).Range
oRange.Find.Execute FindText:="#OSLQA", _
ReplaceWith:=txt_oslqa, Replace:=wdReplaceAll
Set oRange = Nothing
Next
Next

For Each oSection In DOC.Sections()
For var = 1 To 3
Set oRange = oSection.Footers(var).Range
oRange.Find.Execute FindText:="#NLEMI", _
ReplaceWith:=txt_lemi, Replace:=wdReplaceAll
Set oRange = Nothing
Next
Next

For Each oSection In DOC.Sections()
For var = 1 To 3
Set oRange = oSection.Footers(var).Range
oRange.Find.Execute FindText:="#OSLEMI", _
ReplaceWith:=txt_oslemi, Replace:=wdReplaceAll
Set oRange = Nothing
Next
Next


'Código para gerar o nome do arquivo
Dim FNam1 As String
Dim FNam2 As String
Dim FNam3 As String
Dim FNam4 As String
Dim FNam5 As String
Dim FNam6 As String
Dim FNam7 As String
Dim FName As String

FNam1 = "RE"
FNam2 = txt_nre
FNam3 = "COMPESA - LQA"
FNam4 = txt_lqa
FNam5 = "LEMI"
FNam6 = txt_lemi
FNam7 = "-2016"

FName = FNam1 + Space(1) + FNam2 + Space(1) + FNam3 + Space(1) + FNam4 + Space(1) + FNam5 + Space(1) + FNam6 + FNam7

'Código para salvar arquivo Word
  DOC.SaveAs Filename:=FName, FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    
End With
End Sub
Todos os horários são UTC-03:00
Página 1 de 1
Powered by phpBB® Forum Software © phpBB Limited