copia tudo

txtCodigo, lstCodigos, btnGerar, btnAdd

 Private Sub btnAdd_Click()
    If Me.txtCodigo.Text <> "" Then
        Me.lstCodigos.AddItem Me.txtCodigo.Text
        Me.txtCodigo.Text = ""
        Me.txtCodigo.SetFocus
    End If
End Sub
Private Sub btnGerar_Click()
    Dim conn As Object, rs As Object, strConn As String, strSQL As String
    Dim i As Integer, codigoProcurado As String, produto As String, marca As String
    Dim pathExcel As String, doc As Word.Document
    Dim moldura As Object, caixaDados As Object
    Dim rng As Range
    
    If Me.lstCodigos.ListCount = 0 Then Exit Sub
    
    Set doc = ActiveDocument
    doc.Content.Delete
    
    pathExcel = "C:\Placas\Pasta1.xlsx"
    'sei lá qual vai ser a do pc
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & pathExcel & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
    
    conn.Open strConn
    
    For i = 0 To Me.lstCodigos.ListCount - 1
        codigoProcurado = Me.lstCodigos.List(i)
        
        Set rng = doc.Paragraphs.Add(doc.Range(doc.Content.End - 1, doc.Content.End - 1)).Range
        
        strSQL = "SELECT * FROM [Planilha1$] WHERE [código] = " & codigoProcurado
        rs.Open strSQL, conn, 1, 1
        If rs.EOF Then
            rs.Close
            strSQL = "SELECT * FROM [Planilha1$] WHERE [código] = '" & codigoProcurado & "'"
            rs.Open strSQL, conn, 1, 1
        End If
        
        If Not rs.EOF Then
            produto = UCase(Trim(rs.Fields(1).Value & ""))
            marca = UCase(Trim(rs.Fields(2).Value & ""))
            
            ' Moldura
            Set moldura = doc.Shapes.AddShape(5, 25, 20, 800, 550, Anchor:=rng)
            With moldura
                .Line.ForeColor.RGB = RGB(0, 0, 0)
                .Line.Weight = 6: .Fill.Visible = 0
                With .TextFrame
                    .VerticalAnchor = 1: .MarginTop = 80
                    .TextRange.Text = produto
                    .TextRange.ParagraphFormat.Alignment = 1
                    .TextRange.Font.Size = IIf(Len(produto) > 20, 56, 80)
                    .TextRange.Font.Bold = True
                    .TextRange.Font.Color = RGB(0, 0, 0)
                End With
            End With
            
            ' Caixa de Dados com Tabulação
            Set caixaDados = doc.Shapes.AddTextbox(1, 85, 450, 680, 60, Anchor:=rng)
            With caixaDados
                .Line.Visible = 0: .Fill.Visible = 0
                With .TextFrame
                    ' Usamos vbTab para separar o Código da Marca
                    .TextRange.Text = "CÓD: " & codigoProcurado & vbTab & UCase(marca)
                    ' Limpa tabulações anteriores e adiciona uma na posição final da caixa
                    .TextRange.ParagraphFormat.TabStops.ClearAll
                    .TextRange.ParagraphFormat.TabStops.Add Position:=650, Alignment:=2
                    
                    .TextRange.ParagraphFormat.Alignment = 0 ' Alinhamento à esquerda para respeitar o Tab
                    .TextRange.Font.Size = 36
                    .TextRange.Font.Bold = True
                    .TextRange.Font.Color = RGB(0, 0, 0)
                End With
            End With
            
            If i < Me.lstCodigos.ListCount - 1 Then
                doc.Range(doc.Content.End - 1, doc.Content.End - 1).InsertBreak Type:=7
            End If
        End If
        rs.Close
    Next i
    
    conn.Close
    Set rs = Nothing: Set conn = Nothing
    Unload Me
End Sub