Ver Mensaje Individual
  #4 (permalink)  
Antiguo 26/02/2008, 02:54
Avellaneda
Colaborador
 
Fecha de Ingreso: enero-2008
Ubicación: Unas veces aquí, otras veces allí
Mensajes: 1.482
Antigüedad: 16 años, 4 meses
Puntos: 37
Re: insertar tabla en documento word desde vba

Bueno, ahí va el ejemplo. En este caso la conexión a la BD es mediante ADO, así que no olvides marcar esta referencia en el proyecto.

Código:
Private Sub Command1_Click()
    Dim oWord As Object
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim iCols As Integer, iFilas As Integer
    Dim i As Integer
    
    Set oWord = CreateObject("Word.Application")
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & App.Path & "\Prueba.mdb;Persist Security Info=False"
    With rs
        .CursorLocation = adUseClient
        ' abrimos el recordset con 5 campos de la tabla 
        .Open "SELECT Id, Codigo, Producto, Origen, Precio FROM Tabla1", cn, adOpenForwardOnly, adLockReadOnly
        iCols = .Fields.Count    ' nº columnas de la tabla = campos del recordset
        iFilas = .RecordCount    ' nº filas de la tabla = registros del recordset
    End With
    Screen.MousePointer = vbHourglass
    With oWord
        .Documents.Add
        ' configuramos la página
        .ActiveDocument.PageSetup.LeftMargin = 70
        .ActiveDocument.PageSetup.RightMargin = 70
        .ActiveDocument.PageSetup.TopMargin = 30
        .Selection.Font.Name = "Verdana"
        .Selection.Font.Size = 8
        Call .Application.ActiveDocument.Tables.Add(.Application.ActiveDocument.Range, iFilas, iCols)
         ' el encabezado en negrita
        For i = 1 To iCols
            .ActiveDocument.Tables(1).Cell(1, i).Select
            .Selection.Font.Bold = True
            .Application.ActiveDocument.Tables(1).Cell(1, i) = rs.Fields(i - 1).Name
        Next i
        ' repetir encabezado en todas las páginas
        .Selection.SelectRow
        .Selection.Rows.HeadingFormat = True
        iFilas = 1
        iCols = 0
        Do While rs.EOF = False
            iFilas = iFilas + 1
            .ActiveDocument.Tables(1).Cell(iFilas, iCols + 1).Select
            .ActiveDocument.Tables(1).Cell(iFilas, iCols + 1).WordWrap = True
            .ActiveDocument.Tables(1).Cell(iFilas, iCols + 1) = rs(0)
            .ActiveDocument.Tables(1).Cell(iFilas, iCols + 2) = IIf(IsNull(rs(1)), "", rs(1))
            .ActiveDocument.Tables(1).Cell(iFilas, iCols + 3) = IIf(IsNull(rs(2)), "", rs(2))
            .ActiveDocument.Tables(1).Cell(iFilas, iCols + 4) = IIf(IsNull(rs(3)), "", rs(3))
            ' formatear la quinta celda (precio) y alinear a la derecha
            .ActiveDocument.Tables(1).Cell(iFilas, iCols + 5) = IIf(IsNull(rs(4)), "", Format(rs(4), "#,##0.00"))
            .ActiveDocument.Tables(1).Cell(iFilas, iCols + 5).Select
            .Selection.ParagraphFormat.Alignment = 2
            ' siguiente registro
            rs.MoveNext
        Loop
        ' ajustar el ancho de las columnas
        .Selection.Tables(1).Select
        .Selection.Tables(1).AutoFitBehavior (1)
        ' nos posicionamos en la primera celda
        .ActiveDocument.Tables(1).Cell(2, 1).Select
        ' guardamos el documento
        .ActiveDocument.SaveAs App.Path & "\Pedidos.doc"
        ' mostramos el documento
        .Application.Visible = True
    End With
    Screen.MousePointer = vbDefault
    ' liberamos recursos
    rs.Close
    Set oWord = Nothing
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub
Como ya te comenté antes, esto es muy lento. En esta prueba, con 250 registros en la tabla tarda aprox. 2 minutos, mientras que enviando lo mismo a Excel tarda apenas unos segundos.