Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Erro 462, não sei o que fazer!

Tópicos relacionados a códigos VBA, gravação de macros, etc.
 Tópico trancado
  • Avatar do usuário
  • Avatar do usuário

Erro 462, não sei o que fazer!

Por victormonfort
Posts
-  29 Set 2016 às 12:06 #15796
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.
Avatar do usuário

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

Por alexandrevba
Avatar
-  29 Set 2016 às 12:44 #15797
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
Avatar do usuário

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

Por Reinaldo
Avatar
-  29 Set 2016 às 16:03 #15808
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!

Por victormonfort
Posts
-  29 Set 2016 às 22:06 #15816
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!

Por victormonfort
Posts
-  29 Set 2016 às 22:08 #15817
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

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

Por victormonfort
Posts
-  06 Out 2016 às 00:24 #16008
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
 Tópico trancado
 Voltar para “Macros e VBA”
long long title how many chars? lets see 123 ok more? yes 60

We have created lots of YouTube videos just so you can achieve [...]

READ MORE
Another post test yes yes yes or no, maybe ni? :-/

The best flat phpBB theme around. Period. Fine craftmanship and [...]

READ MORE
Do you need a super MOD? Well here it is. chew on this

All you need is right here. Content tag, SEO, listing, Pizza and spaghetti [...]

READ MORE
Lasagna on me this time ok? I got plenty of cash

this should be fantastic. but what about links,images, bbcodes etc etc? [...]

READ MORE

Estamos migrando para uma comunidade no Discord

ENTRAR PARA DISCORD