Olá, pessoal.

Estou com uma planilha do Excel, em que tenho um botão que eu clico, e ele gera um modelo de laudo para mim, em formato de Word. E quando ele faz isso, já puxa todos os dados que estão no Excel e coloca nesse arquivo.doc.

Porém, devido ao pedido de um cliente, preciso trabalhar com um novo modelo de laudo e, portanto, terei que ter MAIS DE UM BOTÃO na planilha, sendo um para cada tipo de laudo.

Gostaria de saber se conseguem me ajudar no passo a passo de como fazer esse novo botão e como criar uma nova programação no VBA para incluir esse novo modelo de laudo.

Envio a foto do Excel e a programação VBA

Obrigado

Option Explicit
Const modeloUS = "C:\Anima\Modelo Laudos\Laudo Abdominal.dotx"
Const pastaLaudos = "C:\Anima\Laudos\Cabeçalhos Prontos\"
Dim wdApp As Word.Application
Private Sub btnGerarLaudo_Clique()
  Dim wdDoc As Word.Document, rgFoco As Excel.Range, rgTbl As Excel.Range, nomeArq As String
  Set rgTbl = Range("A1").CurrentRegion.Offset(1, 0)
    Set rgTbl = rgTbl.Resize(rgTbl.Rows.Count - 1)
  Set rgFoco = Intersect(rgTbl, ActiveCell.EntireRow)
  If Not rgFoco Is Nothing Then
    rgFoco.Select
    On Error Resume Next
      Set wdApp = GetObject(, "Word.Application")
      If wdApp Is Nothing Then Set wdApp = New Word.Application
    On Error GoTo 0
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add(Template:=modeloUS, DocumentType:=wdNewBlankDocument, Visible:=True)
    With wdDoc.Bookmarks
      .Item("bkmLaudo").Range.Text = rgFoco.Columns("B").Value
      .Item("bkmData").Range.Text = rgFoco.Columns("G").Value
      .Item("bkmNome").Range.Text = rgFoco.Columns("I").Value
      .Item("bkmEspécie").Range.Text = rgFoco.Columns("J").Value
      .Item("bkmRaça").Range.Text = rgFoco.Columns("L").Value
      .Item("bkmSexo").Range.Text = rgFoco.Columns("M").Value
      .Item("bkmIdade").Range.Text = rgFoco.Columns("O").Value
      .Item("bkmTutor").Range.Text = rgFoco.Columns("P").Value
      .Item("bkmVeterinário").Range.Text = rgFoco.Columns("Q").Value
      .Item("bkmClínica").Range.Text = rgFoco.Columns("R").Value
      .Item("bkmCidade").Range.Text = rgFoco.Columns("X").Value
      .Item("bkmDia").Range.Text = rgFoco.Columns("AB").Value
      .Item("bkmMes").Range.Text = rgFoco.Columns("AD").Value
      .Item("bkmAno").Range.Text = rgFoco.Columns("AE").Value
    End With
    nomeArq = Trim(pastaLaudos & Replace(rgFoco.Columns("B").Value, "/24", ""))
    nomeArq = nomeArq & " - " & rgFoco.Columns("I")
    wdDoc.SaveAs2 Filename:=nomeArq, FileFormat:=WdSaveFormat.wdFormatDocumentDefault
  End If
  Set rgFoco = Nothing: Set rgTbl = Nothing
  Set wdDoc = Nothing:  Set wdApp = Nothing
End Sub