Excel Abrir Word através do Excel - Correção de erro

[Jessy_1985]

Pessoal,

Tenho um formulário no excel que o usuário preenche e ao clicar num botão específico é gerado um word (mala direta) com os dados daquele formulário. Dentro deste formulário tenho uma combo que o usuário informa se é o arquivo A, B, C ou D que deve ser gerado.

 

O que ocorre é que se um dos documentos estiver aberto e o usuário clicar no botão novamente, o excel trava e fica a mensagem: “O excel está aguardando que outro aplicativo conclua a ação OLE”, nisso abre uma caixa de mensagem avisando que o arquivo está em uso, pedindo se desejamos que o arquivo seja aberto em somente leitura e isso atrapalha muito o usuário

 

Gostaria de uma ajuda para solucionar este problema: Gostaria que enquanto um dos documentos A, B, C ou D estiverem abertos, o usuário ao clicar no botão receba uma mensagem avisando feche o arquivo (A, B, C ou D) para gerar um novo arquivo. Em resumo, se já existe o documento aberto, o código não deve ser executado, apenas alertar o usuário, se não houver documento aberto, deve executar normalmente a abertura do documento. Lembrando que outros arquivos do Word que estiverem abertos e que não tenham nada a ver com este fluxo não poderão ser afetados.

 

Meu código:

 

Sub abrirword()

Set wordapp = CreateObject("word.Application")

 

Sheets("Relatório").Activate

If Range("F5") = 1 Then

    wordapp.Visible = True

    wordapp.Documents.Open "C:\Users\xxxxxxx\Documents\ xxxxxxx \ xxxxxxx \Modelos_Não alterar\Com Complemento.docx"

    wordapp.Activate

    Application.ScreenUpdating = True

   

    Else

    wordapp.Visible = True

    wordapp.Documents.Open " C:\Users\xxxxxxx\Documents\ xxxxxxx \ xxxxxxx \Modelos_Não alterar\Sem Complemento.docx "

    wordapp.Activate

    Application.ScreenUpdating = True

    End If

End Sub

 

Muito obrigada.

[Jessy_1985]

Em 07/01/2020 às 16:25, Jessy_1985 disse:

Pessoal,

Tenho um formulário no excel que o usuário preenche e ao clicar num botão específico é gerado um word (mala direta) com os dados daquele formulário. Dentro deste formulário tenho uma combo que o usuário informa se é o arquivo A, B, C ou D que deve ser gerado.

 

O que ocorre é que se um dos documentos estiver aberto e o usuário clicar no botão novamente, o excel trava e fica a mensagem: “O excel está aguardando que outro aplicativo conclua a ação OLE”, nisso abre uma caixa de mensagem avisando que o arquivo está em uso, pedindo se desejamos que o arquivo seja aberto em somente leitura e isso atrapalha muito o usuário

 

Gostaria de uma ajuda para solucionar este problema: Gostaria que enquanto um dos documentos A, B, C ou D estiverem abertos, o usuário ao clicar no botão receba uma mensagem avisando feche o arquivo (A, B, C ou D) para gerar um novo arquivo. Em resumo, se já existe o documento aberto, o código não deve ser executado, apenas alertar o usuário, se não houver documento aberto, deve executar normalmente a abertura do documento. Lembrando que outros arquivos do Word que estiverem abertos e que não tenham nada a ver com este fluxo não poderão ser afetados.

 

Meu código:

 

Sub abrirword()

Set wordapp = CreateObject("word.Application")

 

Sheets("Relatório").Activate

If Range("F5") = 1 Then

    wordapp.Visible = True

    wordapp.Documents.Open "C:\Users\xxxxxxx\Documents\ xxxxxxx \ xxxxxxx \Modelos_Não alterar\Com Complemento.docx"

    wordapp.Activate

    Application.ScreenUpdating = True

   

    Else

    wordapp.Visible = True

    wordapp.Documents.Open " C:\Users\xxxxxxx\Documents\ xxxxxxx \ xxxxxxx \Modelos_Não alterar\Sem Complemento.docx "

    wordapp.Activate

    Application.ScreenUpdating = True

    End If

End Sub

 

Muito obrigada.

@osvaldomp não querendo abusar dos seus conhecimentos, você teria alguma ideia para me ajudar?

 

[Edson Luiz Branco]

Boa tarde, @Jessy_1985 e bom ano pra ti.

Enquanto aguardamos o Mestre Osvaldo, teste a seguinte opção:

Option Explicit
Option Compare Text
Sub AbrirWord()
  Const caminho = "C:\Users\xxxxxxx\Documents\ xxxxxxx \ xxxxxxx \Modelos_Não alterar\"
  Const arqA = "Com Complemento.docx"
  Const arqB = "Sem Complemento.docx"
  Dim wordDoc As Object
  Application.ScreenUpdating = False
    Sheets("Relatório").Activate
    If Range("F5") = 1 Then
      If EstáAberto(caminho & arqA) Then
        MsgBox ("Feche o arquivo " & arqA & " antes de continuar")
        Exit Sub
      Else
        Set wordDoc = GetObject(caminho & arqA)
      End If
    Else
      If EstáAberto(caminho & arqB) Then
        MsgBox ("Feche o arquivo " & arqB & " antes de continuar")
        Exit Sub
      Else
        Set wordDoc = GetObject(caminho & arqB)
      End If
    End If
    wordDoc.Parent.Visible = True
    wordDoc.Parent.Activate
  Application.ScreenUpdating = True
  Set wordDoc = Nothing
End Sub
Function EstáAberto(FullNameArq As String) As Boolean
  Dim wordApp As Object, i As Long
  On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If Err.Number = 0 Then
      If wordApp.Documents.Count > 0 Then
        For i = 1 To wordApp.Documents.Count
          If wordApp.Documents(i).FullName = (FullNameArq) Then
            EstáAberto = True
            Exit For
          End If
        Next i
      End If
    End If
  On Error GoTo 0
  Set wordApp = Nothing
End Function

 

[Jessy_1985]

@Edson Luiz Branco nossa super funcionou, mas eu fui tentar adaptar para mais condições e deu erro (comentado em vermelho), poderia me ajudar? Será que fiz as condições erradas?:

 

Option Explicit
Option Compare Text
Sub AbrirWord()
  Const caminho = "C:\Users\xxxxxxx\Documents\ xxxxxxx \ xxxxxxx \Modelos_Não alterar\\"
  Const arqA = "Homônimo.docx"
  Const arqB = "Positivo.docx"
  Const arqC = "Negativo.docx"
  Const arqD = "Parte.docx"
  
  Dim wordDoc As Object
  Application.ScreenUpdating = False
  
    Sheets("Relatório").Activate

      If Range("F5") = 1 Then
      If EstáAberto(caminho & arqA) Then
        MsgBox ("Feche o arquivo " & arqA & " antes de continuar")
        Exit Sub
      Else
        Set wordDoc = GetObject(caminho & arqA)
      End If
    
       If Range("F5") = 2 Then
      If EstáAberto(caminho & arqB) Then
        MsgBox ("Feche o arquivo " & arqB & " antes de continuar")
        Exit Sub
      Else
        Set wordDoc = GetObject(caminho & arqB)
      End If
    
    If Range("F5") = 3 Then
      If EstáAberto(caminho & arqC) Then
        MsgBox ("Feche o arquivo " & arqC & " antes de continuar")
        Exit Sub
      Else
        Set wordDoc = GetObject(caminho & arqC)
      End If
        
      Else
      If EstáAberto(caminho & arqD) Then
        MsgBox ("Feche o arquivo " & arqD & " antes de continuar")
        Exit Sub
      Else
        Set wordDoc = GetObject(caminho & arqD)
      End If
    End If
    End If
    End If
    wordDoc.Parent.Visible = True 'Erro em tempo de execução 91: A variável do objeto ou a variável do bloco 'with' não foi definida.
    wordDoc.Parent.Activate
  Application.ScreenUpdating = True
  Set wordDoc = Nothing
End Sub
Function EstáAberto(FullNameArq As String) As Boolean
  Dim wordApp As Object, i As Long
  On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If Err.Number = 0 Then
      If wordApp.Documents.Count > 0 Then
        For i = 1 To wordApp.Documents.Count
          If wordApp.Documents(i).FullName = (FullNameArq) Then
            EstáAberto = True
            Exit For
          End If
        Next i
      End If
    End If
  On Error GoTo 0
  Set wordApp = Nothing
End Function

 

 

[Edson Luiz Branco]

57 minutos atrás, Jessy_1985 disse:

Será que fiz as condições erradas?:

Sim, Jessy, o aninhamento de seus blocos If's ficou incorreto ou, alternativamente, você poderia ter usado ElseIf's a cada mudança. Mas ao invés disso, vamos fazer algo mais simples? Colocando os nomes de arquivo numa matriz, basta aproveitar a opção escolhida lá da F5 da planilha, visto que é numérica e usá-la como índice para retornar o elemento correto da matriz. Vejamos:

Option Explicit
Option Compare Text
Sub AbrirWord()
  Const caminho = "C:\Users\xxxxxxx\Documents\ xxxxxxx \ xxxxxxx \Modelos_Não alterar\"
  Dim wordDoc As Object
  Dim Escolha As Long
  Dim NomeArqs(1 To 4) As String
    NomeArqs(1) = "Homônimo.docx":   NomeArqs(2) = "Positivo.docx"
    NomeArqs(3) = "Negativo.docx":   NomeArqs(4) = "Parte.docx"
  Application.ScreenUpdating = False
  Sheets("Relatório").Activate
  Escolha = Range("F5").Value
  If Escolha >= 1 And Escolha <= 4 Then
    If EstáAberto(caminho & NomeArqs(Escolha)) Then
      MsgBox ("Feche o arquivo " & NomeArqs(Escolha) & " antes de continuar")
      Exit Sub
    Else
      Set wordDoc = GetObject(caminho & NomeArqs(Escolha))
    End If
    wordDoc.Parent.Visible = True
    wordDoc.Parent.Activate
  End If
  Application.ScreenUpdating = True
  Set wordDoc = Nothing
End Sub
Function EstáAberto(FullNameArq As String) As Boolean
  Dim wordApp As Object, i As Long
  On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If Err.Number = 0 Then
      If wordApp.Documents.Count > 0 Then
        For i = 1 To wordApp.Documents.Count
          If wordApp.Documents(i).FullName = (FullNameArq) Then
            EstáAberto = True
            Exit For
          End If
        Next i
      End If
    End If
  On Error GoTo 0
  Set wordApp = Nothing
End Function

Obs.:

• Note que a Function EstáAberto() não sofreu alteração nenhuma;
• Sua Const Caminho está com duas barras no final, isso também poderá dar erro.

[Jessy_1985]

@Edson Luiz Branco super funcionou, nossa muito obrigada pela ajuda, Deus te abençoe! Se pudesse te mandava uma caixa de chocolate e um abraço!!!!

Muito obrigada mesmo!

[Edson Luiz Branco]

5 minutos atrás, Jessy_1985 disse:

Se pudesse te mandava uma caixa de chocolate e um abraço!!!!

 Obaaaa! Até que cairia bem... rsrsrsrs