1

Boa tarde, nunca programei em VBA mas me encontrei em uma necessidade onde estou precisando de gerar uma documento word a partir de algumas células de uma planilha no excel, depois de procurar vários sites na internet consegui fazer um script que funciona, o problema é que aleatoriamente está dando o erro abaixo, sei que o script provavelmente não está bom mas ele está funcional, o problema realmente é somente esse erro que acontece vez ou outra, quando o mesmo ocorre e eu copio a célula novamente e mando continuar ele segue normalmente, no caso do print abaixo ele já tinha gerado 22 arquivos e no 23º ele apresentou esse erro.

inserir a descrição da imagem aqui

Dim path_src As String
Dim path_dest As String
Dim nome_dest As String
' Define word object
Dim WA As Object
Dim cs As Worksheet
Dim linha As Integer
Dim xRg As Range
Dim I As Variant
Dim proj As String
Dim cen As String
Dim amb As String




Function copiar(cel1 As String)
    cs.Range(cel1).Copy
End Function


Sub criarEv()



    'Planilha

    Set cs = ActiveWorkbook.Worksheets("Plan1")
    'seleção de casos de teste
    Set xRg = Application.InputBox("Selecione os casos de testes", "Teste", ActiveWindow.RangeSelection.Address, , , , , 8)
    proj = InputBox("Informe o nome do projeto")
    nome_dest = InputBox("Informe o caminho para salvar as evidencias")

    path_src = "R:\MelhoriasQA\templates\template caso de teste.doc"
    amb = InputBox("Informe o ambiente em que os testes serão executados:")

    ' Data worksheet "Data" col A find text, Col B replace text
    Set cs = ActiveWorkbook.Worksheets("Plan1")

    Set WA = CreateObject("Word.Application")

    WA.Visible = True

    ' Verificar possibilidade de passar este carra como parametro
    linha = 6

    ' Este TB


    I = 1

    For Each I In xRg


        ' Abertura da planilha
        WA.Documents.Open (path_src)

        ' Set word object active
        WA.Activate
        WA.Selection.MoveRight Unit:=wdCell
        WA.Selection.MoveRight Unit:=wdCell
        WA.Selection.MoveRight Unit:=wdCell
        WA.Selection.MoveRight Unit:=wdCell
        'Projeto:
        WA.Selection.TypeText Text:=proj
        WA.Selection.MoveRight Unit:=wdCell
        WA.Selection.MoveRight Unit:=wdCell
        'Cenário:
        copiar "b" & linha
        WA.Selection.PasteAndFormat (wdFormatPlainText)
        WA.Selection.MoveRight Unit:=wdCell
        WA.Selection.MoveRight Unit:=wdCell
        'Pré-requisito para teste:
        copiar "g" & linha
        WA.Selection.PasteAndFormat (wdFormatPlainText)
        WA.Selection.MoveRight Unit:=wdCell
        WA.Selection.MoveRight Unit:=wdCell
        'Caso de Teste:
        copiar "c" & linha
        WA.Selection.PasteAndFormat (wdFormatPlainText)
        WA.Selection.TypeText Text:=" - "
        copiar "d" & linha
        WA.Selection.PasteAndFormat (wdFormatPlainText)
        WA.Selection.MoveRight Unit:=wdCell
        WA.Selection.MoveRight Unit:=wdCell
        'Resultado Esperado:
        copiar "i" & linha
        WA.Selection.PasteAndFormat (wdFormatPlainText)
        'Ambiente
        WA.Selection.MoveRight Unit:=wdCell
        WA.Selection.MoveRight Unit:=wdCell
        WA.Selection.TypeText Text:=amb
        WA.Selection.MoveDown Unit:=wdLine, Count:=3
        'Passos
        copiar "h" & linha
        WA.Selection.PasteAndFormat (wdFormatPlainText)
        WA.Selection.TypeParagraph
        cen = "c" & linha


        path_dest = nome_dest & "\" & proj & "_RTXXX_" & "CT" & cs.Range(cen).Value & ".doc"


        WA.Application.ActiveDocument.SaveAs path_dest
        WA.Documents.Close

        linha = linha + 1
    Next
    MsgBox ("Feito!!!")
    Set WA = Nothing
End Sub
3
  • Qual é a linha em que o erro ocorre? E declare linhas como Long e não Integer Commented 28/11/2018 às 16:38
  • Na verdade as linhas onde ocorre a colagem co conteúdo copiado, isso acontece por vezes em uma linha por vezes em outra, a unica relação é que sempre ocorre na linha em que está colando o conteúdo (WA.Selection.PasteAndFormat (wdFormatPlainText)) Commented 29/11/2018 às 10:29
  • Não consigo replicar o problema, mas eu trocaria de Set cs = ActiveWorkbook.Worksheets("Plan1") para Set cs = ThisWorkbook.Worksheets("Plan1"). E a função copiar para inserir um worksheet: Function copiar(cel1 As String, cs as Worksheet) Commented 29/11/2018 às 19:32

0

Você deve fazer log-in para responder a esta pergunta.

Pesquise outras perguntas com a tag .