Este fórum está sendo desativado

[SSMAILEEN]

Boa tarde, pessoal!

Estou trabalhando em uma planilha para o meu trabalho e me deparei com um problema... Pesquisei em diversos sites e não encontro a solução

Estou formulando uma planilha que gera um documento Word a partir de um formulário do excel. Até ai, tudo bem. Entretanto, existe uma parte da planilha onde eu devo "clicar" em um hiperlink, o mesmo irá abrir outro documento, devo copiar todo o texto desse documento e colar no lugar específico de outro documento gerado.
Porém, esse documento gerado eu fiz com as Ferramentas herdadas do Word...
Aqui segue o código:

Código: Selecionar todos

Private Sub BotaoSalvar_Click()

'Definir variáveis globais
conc1 = CStr(CBConc1.Value)
conc2 = CStr(CBConc2.Value)
conc3 = CStr(CBConc3.Value)
conc4 = CStr(CBConc4.Value)
conc5 = CStr(CBConc5.Value)

'Se a escolha for o relatório geral
If relatorio = "Geral" Then
    Dim relgeral As Object
    Dim documento As Object
    Set relgeral = CreateObject("Word.Application")
    Set documento = CreateObject("Word.Document")
    Set documento = relgeral.Documents.Add(ThisWorkbook.Path & "\RE-Geral.docx")
        With documento
            .FormFields("Wnome").Range = nome
            .FormFields("Wchefe").Range = chefe
            .FormFields("Wdia").Range = dia
            .FormFields("Wmes").Range = mes
            .FormFields("Wano").Range = ano
                    
            'INTRODUÇÃO
            Sheets("Mestra").Visible = True
            ThisWorkbook.Worksheets("Mestra").Activate
            Range("H4").Select
            ultimalinhaint = Range("H5").End(xlDown).Row
                    
            'Testa a PRIMEIRA variável da INTRODUÇÃO
            If int1 <> "" Then
                Do While ActiveCell.Value <> int1
                    If ActiveCell.Row = ultimalinhaint Then
                        Exit Do
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                    
[b]                If ActiveCell.Value = int1 Then
                    ActiveCell.Offset(0, 1).Select
                    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
                    Dim pag As Range
                    Set pag = ActiveDocument.Range(Start:=0, End:=0)
                    With pag
                        .Selection.WholeStory
                        .Selection.Copy
                    End With
                    
                    documento.Documents.Open
                    documento.Activate
                    Selection.Collapse Direction:=Wint1
                    Selection.InsertFile Filename:=pag, Link:=True
                    
                End If[/b]
                    
            Else
                .FormFields("Wint1").Range = ""
            End If
                        
            'Testa a SEGUNDA variável da INTRODUÇÃO
            Range("H4").Select
            If int2 <> "" Then
                Do While ActiveCell.Value <> int2
                    If ActiveCell.Row = ultimalinhaint Then
                        Exit Do
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                    
                If ActiveCell.Value = int2 Then
                    .FormFields("Wint2").Range = ActiveCell.Offset(0, 1).Value
                End If
                    
            Else
                .FormFields("Wint2").Range = ""
            End If
            
         'ANALISE
            Sheets("Mestra").Visible = True
            ThisWorkbook.Worksheets("Mestra").Activate
            Range("E4").Select
            ultimalinhaana = Range("E5").End(xlDown).Row
                    
            'Testa a PRIMEIRA variável da ANÁLISE
            If ana1 <> "" Then
                Do While ActiveCell.Value <> ana1
                    If ActiveCell.Row = ultimalinhaana Then
                        Exit Do
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                    
                If ActiveCell.Value = ana1 Then
                    .FormFields("Wana1").Range = ActiveCell.Offset(0, 1).Value
                End If
                    
            Else
                .FormFields("Wana1").Range = ""
            End If
                        
            'Testa a SEGUNDA variável da ANÁLISE
            Range("E4").Select
             If ana2 <> "" Then
                Do While ActiveCell.Value <> ana2
                    If ActiveCell.Row = ultimalinhaana Then
                        Exit Do
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                    
                If ActiveCell.Value = ana2 Then
                    .FormFields("Wana2").Range = ActiveCell.Offset(0, 1).Value
                End If
                    
            Else
                .FormFields("Wana2").Range = ""
            End If
            
            'Testa a TERCEIRA variável da ANÁLISE
            Range("E4").Select
             If ana3 <> "" Then
                Do While ActiveCell.Value <> ana3
                    If ActiveCell.Row = ultimalinhaana Then
                        Exit Do
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                    
                If ActiveCell.Value = ana3 Then
                    .FormFields("Wana3").Range = ActiveCell.Offset(0, 1).Value
                End If
                    
            Else
                .FormFields("Wana3").Range = ""
            End If
            
        'CONCLUSÃO
            Sheets("Mestra").Visible = True
            ThisWorkbook.Worksheets("Mestra").Activate
            Range("B4").Select
            ultimalinhaconc = Range("B5").End(xlDown).Row
                    
            'Testa a PRIMEIRA variável da CONCLUSÃO
            If conc1 <> "" Then
                Do While ActiveCell.Value <> conc1
                    If ActiveCell.Row = ultimalinhaconc Then
                        Exit Do
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                    
                If ActiveCell.Value = conc1 Then
                    .FormFields("Wconc1").Range = ActiveCell.Offset(0, 1).Value1
                End If
                    
            Else
                .FormFields("Wconc1").Range = ""
            End If
            
            'Testa a SEGUNDA variável da CONCLUSÃO
            Range("B4").Select
            If conc2 <> "" Then
                Do While ActiveCell.Value <> conc2
                    If ActiveCell.Row = ultimalinhaconc Then
                        Exit Do
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                    
                If ActiveCell.Value = conc2 Then
                    .FormFields("Wconc2").Range = ActiveCell.Offset(0, 1).Value2
                End If
                    
            Else
                .FormFields("Wconc2").Range = ""
            End If
            
            'Testa a TERCEIRA variável da CONCLUSÃO
            Range("B4").Select
            If conc3 <> "" Then
                Do While ActiveCell.Value <> conc3
                    If ActiveCell.Row = ultimalinhaconc Then
                        Exit Do
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                    
                If ActiveCell.Value = conc3 Then
                    .FormFields("Wconc3").Range = ActiveCell.Offset(0, 1).Value2
                End If
                    
            Else
                .FormFields("Wconc3").Range = ""
            End If
            
            'Testa a QUARTA variável da CONCLUSÃO
            Range("B4").Select
            If conc4 <> "" Then
                Do While ActiveCell.Value <> conc4
                    If ActiveCell.Row = ultimalinhaconc Then
                        Exit Do
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                    
                If ActiveCell.Value = conc4 Then
                    .FormFields("Wconc4").Range = ActiveCell.Offset(0, 1).Value2
                End If
                    
            Else
                .FormFields("Wconc4").Range = ""
            End If
            
            'Testa a QUINTA variável da CONCLUSÃO
            Range("B4").Select
            If conc5 <> "" Then
                Do While ActiveCell.Value <> conc5
                    If ActiveCell.Row = ultimalinhaconc Then
                        Exit Do
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                    
                If ActiveCell.Value = conc5 Then
                    .FormFields("Wconc5").Range = ActiveCell.Offset(0, 1).Value2
                End If
                    
            Else
                .FormFields("Wconc5").Range = ""
            End If
                            
        'Abre o documento pronto
        relgeral.Visible = True
        End With
End If

End Sub

No caso, a parte em negrito é onde eu devo abrir o hiperlink, extrair o texto contido nesse documento e passar ele para o outro Work gerado... Nesse documento, gerei o espaço com a Ferramenta de Campo de Texto de Formulários Herdados.
Muito obrigada!!!

[eduardogrigull]

Tens como anexar uma planilha teste?