Olá pessoal,

Estou iniciando no mundo VBA, pois preciso resolver um problema e estou apanhando bastante... Agradeço se puderem me ajudar....

Para facilitar o entendimento: minha esposa faz exames de ultrassom em animais e ela precisa fazer os laudos num documento do Word. Porém, a cada novo laudo, a gente preenche os dados em uma planilha e depois repete o preenchimento no cabeçalho do laudo.

O problema: Gostaria de fazer o preenchimento dos dados apenas uma vez, no Excel, e que apertando um botão, os dados já sejam passados automaticamente para o Word, criando um novo arquivo, com um novo nome.

Por partes, de como está a situação até agora:

1. Tenho uma planilha no Excel, que contém diversos dados, como nome do paciente, idade, sexo, clínica, proprietário, etc.

2. Já consegui fazer um VBA para colocar os dados, apertar "OK" e ele alimenta a planilha do Excel.

3. Descobri que tenho, no Word, que colocar no cabeçalho do laudo "palavras-chave" para conseguir fazer o programa entender onde quero cada informação. Por exemplo #nomepaciente, #idadepaciente, #sexopaciente, etc.

O que preciso de ajuda para fazer:

1. Fazer o Excel "chamar" o arquivo "modelo_laudo" para poder inserir as informações ali.

2. Jogar as informações necessárias no "modelo_laudo".

3. Renomear o arquivo para um nome diferente em cada caso.

OBS: O nome dos arquivos normalmente é sequenciado para cada clínica diferente, seguido do nome do paciente. Por exemplo: "ABC 001 - Tobi"; "CDE 012 - Pluto"; "XYZ 036 - Totó".

OBS2: O nome "ABC 001", "CDE 012" já é gerado automaticamente, conforme a quantidade de exames que foi feito em cada clínica (ver excel). Porém o nome do animal não. Preciso juntar essas duas informações para dar o nome correto ao arquivo.

Agradeço toda a ajuda que puderem me dar. Estou apanhando aqui faz algumas semanas, para tentar fazer isso funcionar, mas não vai.... Qualquer informação que precisarem, só avisar...

Obrigado e Abraços

Como está minha programação VBA até o momento (acabei de testar aqui, e o Excel não abriu a minha tela Userform. Não sei o que aconteceu. Copiei de um computador para o outro e acho que deve ter dado pau):

Private Sub Botao_Salvar_Click()

  'COMANDO PARA INSERIR OS VALORES NA PLANILHA
  linha = Sheets("2020").Range("C2").End(xlDown).Row + 1

  Fixo_Laudo = Cells(linha, 2)
  Cells(linha, 3) = Cx_Tipo.Value
  Cells(linha, 5) = Cx_Local.Value
  Cells(linha, 7) = Cx_Data.Value
  Cells(linha, 9) = Cx_Nome.Value
  Cells(linha, 10) = Cx_Especie.Value
  Cells(linha, 12) = Cx_Raca.Value
  If Op_Macho.Value = True Then
    Cells(linha, 13) = "Macho"
  Else
    Cells(linha, 13) = "Fêmea"
  End If

  'COMANDO PARA ANOS, MESES E DIAS
  'Se as tres caixas estiverem preenchidas
  If Cx_Anos.Value <> "" And Cx_Meses.Value <> "" And Cx_Dias.Value <> "" Then
    Cells(linha, 15) = Cx_Anos.Value & " Anos " & Cx_Meses.Value & " Meses " & Cx_Dias & " Dias"
  'Se apeas a caixa anos e meses estiver preenchida
  ElseIf Cx_Anos.Value <> "" And Cx_Meses.Value <> "" And Cx_Dias.Value = "" Then
    Cells(linha, 15) = Cx_Anos.Value & " Anos " & Cx_Meses.Value & " Meses"
  'Se apeas a caixa anos e dias estiver preenchida
  ElseIf Cx_Anos.Value <> "" And Cx_Meses.Value = "" And Cx_Dias.Value <> "" Then
    Cells(linha, 15) = Cx_Anos.Value & " Anos " & Cx_Dias & " Dias"
  'Se apeas a caixa meses e dias estiver preenchida
  ElseIf Cx_Anos.Value = "" And Cx_Meses.Value <> "" And Cx_Dias.Value <> "" Then
    Cells(linha, 15) = Cx_Meses.Value & " Meses " & Cx_Dias & " Dias"
  'Se Apenas a caixa anos estiver preenchida
  ElseIf Cx_Anos.Value <> "" And Cx_Meses.Value = "" And Cx_Dias.Value = "" Then
    Cells(linha, 15) = Cx_Anos.Value & " Anos"
  'Se Apenas a caixa meses estiver preenchida
  ElseIf Cx_Anos.Value = "" And Cx_Meses.Value <> "" And Cx_Dias.Value = "" Then
    Cells(linha, 15) = Cx_Meses.Value & " Meses"
  'Se Apenas a caixa dias estiver preenchida
  ElseIf Cx_Anos.Value = "" And Cx_Meses.Value = "" And Cx_Dias.Value <> "" Then
    Cells(linha, 15) = Cx_Dias & " Dias"
  'Se nenhuma das 3 estiver preenchida estiver preenchida
  Else
    Cells(linha, 15) = "Desc."
  End If

  Cells(linha, 16) = CX_Prop.Value
  Cells(linha, 17) = Cx_Vet.Value
  Cells(linha, 22) = CX_Valor.Value
  If Op_Sim.Value = True Then
    Cells(linha, 23) = "Sim"
  Else
    Cells(linha, 23) = "Não"
  End If
  Fixo_Cidade = Cells(linha, 24)
  Fixo_Laudo = Cells(linha, 2)

  MsgBox ("Exame cadastrado com sucesso")

End Sub

Private Sub UserForm_Initialize()

  ult_linhaA = Sheets("DadosVBA").Range("A2").End(xlDown).Row

  Cx_Tipo.RowSource = "DadosVBA!A2:A" & ult_linhaA

  ult_linhaB = Sheets("DadosVBA").Range("B2").End(xlDown).Row

  Cx_Local.RowSource = "DadosVBA!B2:B" & ult_linhaB

  ult_linhaC = Sheets("DadosVBA").Range("C2").End(xlDown).Row

  Cx_Especie.RowSource = "DadosVBA!C2:C" & ult_linhaC

  ult_linhaD = Sheets("DadosVBA").Range("D2").End(xlDown).Row

  Cx_Raca.RowSource = "DadosVBA!D2:D" & ult_linhaD

  ult_linhaE = Sheets("DadosVBA").Range("E2").End(xlDown).Row

  Cx_Vet.RowSource = "DadosVBA!E2:E" & ult_linhaE

  ult_linhaF = Sheets("DadosVBA").Range("F2").End(xlDown).Row

  Cx_Clinica.RowSource = "DadosVBA!F2:F" & ult_linhaF

End Sub

Private Sub Botao_Cancelar_Click()

  Unload Cadastro_exame

End Sub