Resumen Interface MS Word ( el codigo prometido )

Mensaje enviado por jfo@tragsatec.es

>De todas formas por ahi debo tener un ejemplo de como hacer algo parecido a
>lo que quieres,luego te lo busco y si lo encuentro te lo mando

Bueno pues ahi va

Public Function Documento()
    Dim oWord As Word.Application
    Dim oWDoc As Word.Document
    Dim db As Database
    Dim rs As Recordset
    Dim rs2 As Recordset
    Dim qf As QueryDef
    Dim bNeg As Boolean
    Dim dRet As Date
    Dim nLlevo As Integer
    Dim nCual As Integer

    Set oWord = CreateObject("Word.Application")
    Set db = OpenDatabase(App.path & "\base")
    Set rs = db.OpenRecordset("select * from [#tablas] order by idtabla")

    With oWord
        On Error GoTo err_doc
        ' Minimizado
        .WindowState = wdWindowStateMinimize
        ' Visible
        .Visible = True
        ' Creo un nuevo documento basado en la plantilla base.dot
        .Documents.Add App.path & "\base.dot", False
        Set oWDoc = oWord.ActiveDocument

        If Not rs.EOF Then
            nLlevo = 1
            ' Selecciono el estilo Título 1
            Selection.Style = oWDoc.Styles("Título 1")
            ' Escribo un texto
            Selection.TypeText text:=" Tablas"
            ' Salto de linea
            Selection.TypeParagraph
            Selection.TypeParagraph

            Do Until rs.EOF
                ' Si llevo escritas mas de 68 lineas fuerzo un salto de pagina
                If Selection.Information(wdFirstCharacterLineNumber) > 68 Then
                    Selection.InsertBreak Type:=wdPageBreak
                End If
                ' Añado una tabla de 2 filas y 2 columnas
                oWDoc.Tables.Add Selection.Range, 2, 2
                ' Le doy formato
                Selection.Cells.SetWidth CentimetersToPoints(2.5), wdAdjustNone
                Selection.Rows.SpaceBetweenColumns = CentimetersToPoints(0.25)
                Selection.Move wdColumn, 1
                Selection.SelectColumn
                Selection.Cells.SetWidth ColumnWidth:=CentimetersToPoints(12.5), RulerStyle:=wdAdjustNone
                Selection.Rows.SpaceBetweenColumns = CentimetersToPoints(0.25)
                ' Dar formato a las dos primeras columnas
                Selection.MoveLeft wdCell, Count:=1
                Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
                Selection.MoveLeft Unit:=wdCharacter, Count:=2
                Selection.TypeText text:="Tabla"
                Selection.MoveRight Unit:=wdCharacter, Count:=1
                Selection.Style = oWDoc.Styles("Título 4")
                Selection.TypeText rs(1)
                Selection.MoveDown Unit:=wdLine, Count:=1
                Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Selection.TypeText text:="Descripción"
                Selection.MoveRight Unit:=wdCharacter, Count:=1
                Selection.TypeText "" & rs(2)

                Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
                Selection.MoveLeft wdCell, Count:=2
                Selection.SelectColumn
                Selection.Shading.Texture = wdTexture30Percent
                Selection.Shading.ForegroundPatternColorIndex = wdBlack
                Selection.Shading.BackgroundPatternColorIndex = wdWhite
                Selection.Font.ColorIndex = wdWhite

                Selection.EndKey Unit:=wdStory
                Selection.TypeParagraph


                Set qf = db.QueryDefs("ObtenerDatosTabla")
                qf.Parameters(0) = rs(0)
                Set rs2 = qf.OpenRecordset()
                rs2.MoveLast
                rs2.MoveFirst
                ' Nueva comprobacion del numero de lineas escrito para producir el salto de pagina
                If Selection.Information(wdFirstCharacterLineNumber) > 68 Then
                    Selection.InsertBreak Type:=wdPageBreak
                End If

                ' Añado una tabla de tantas filas como tenga en el recordset que quiero imprimir
                ' mas 1 ( que hara de titulo ) y tres columnas
                oWDoc.Tables.Add Selection.Range, rs2.RecordCount + 1, 3
                ' Le doy formato a esta tabla
                Selection.Tables(1).AutoFormat wdTableFormatGrid8, True, True, True, True, True, False, True, False, True
                Selection.Cells.SetWidth CentimetersToPoints(3.5), wdAdjustNone
                Selection.Rows.SpaceBetweenColumns = CentimetersToPoints(0.25)
                Selection.Move Unit:=wdColumn, Count:=1
                Selection.SelectColumn
                Selection.Cells.SetWidth CentimetersToPoints(2.5), wdAdjustNone
                Selection.Rows.SpaceBetweenColumns = CentimetersToPoints(0.25)
                Selection.Move Unit:=wdColumn, Count:=1
                Selection.SelectColumn
                Selection.Cells.SetWidth CentimetersToPoints(9.12), wdAdjustNone
                Selection.Rows.SpaceBetweenColumns = CentimetersToPoints(0.25)

                ' Poner los titulos de las columnas
                Selection.MoveLeft Unit:=wdCharacter, Count:=3
                Selection.TypeText text:="Nombre"
                Selection.MoveRight Unit:=wdCharacter, Count:=1
                Selection.TypeText text:="Tipo"
                Selection.MoveRight Unit:=wdCharacter, Count:=1
                Selection.TypeText text:="Descripción"
                Selection.MoveRight Unit:=wdCharacter, Count:=1

                ' Seleccionar la primera fila y centrar los textos
                Selection.SelectRow
                Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
                Selection.MoveDown wdLine, 1, wdMove
                ' A escribir los datos que tengo en la tabla
                Do Until rs2.EOF
                   Selection.TypeText rs2(0)
                   Selection.MoveRight wdCharacter, 1
                   Selection.TypeText rs2(1)
                   Selection.MoveRight wdCharacter, 1
                   Selection.TypeText "" & rs2(2)
                   Selection.MoveRight wdCharacter, 2
                   rs2.MoveNext
                Loop
                'Selection.MoveDown Unit:=wdLine, Count:=2
                Selection.EndKey Unit:=wdStory
                Selection.TypeParagraph
                Selection.TypeParagraph

                Set qf = db.QueryDefs("ObtenerDatosIndices")
                qf.Parameters(0) = rs(0)
                Set rs2 = qf.OpenRecordset()
                If Not rs2.EOF Then
                    rs2.MoveLast
                    rs2.MoveFirst
                    ' Cambio el tamaño de font y el estilo
                    Selection.Font.size = 12
                    Selection.Font.Bold = wdToggle
                    Selection.TypeText text:=" Indices"
                    Selection.Font.Bold = wdToggle
                    Selection.TypeParagraph
                    Selection.Style = oWDoc.Styles("Normal")
                    Do Until rs2.EOF
                       Selection.TypeText text:=" " & rs2(0) & " (" & rs2(1) & ")"
                       Selection.TypeParagraph
                       rs2.MoveNext
                    Loop
                End If

                Selection.TypeParagraph
                rs.MoveNext
            Loop
            Selection.InsertBreak Type:=wdPageBreak
            ' Salvar el documento
            oWDoc.SaveAs docDestino
        End If
        .Quit

    End With
Salir:
        Exit Function
err_doc:
        'Resume
        oWDoc.SaveAs docDestino
        oWord.Quit
        MsgBox Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Error"
        GoTo Salir
End Function


Como vereis es bastante "pedalero", sobre todo en lo que es el control del movimiento, practicamente todo es copia del codigo que se genera al hacer una macro en Word. Tambien debeis tener presente que es especifico para un tipo de documento que tenia que realizar en su momento, por lo que quizas como ejemplo didactico no sea el mas valido,por ello abundo en lo dicho anteriormente la mejor manera, aunque quiza no sea la mas optimizada, de crear el documento sea hacer uno con una macro y ver el codigo

Si teneis algun problema en concreto ya sabeis donde estamos, aunque la verdad es que el cosigo este tiene ya casi un par de años y desde entonces no he vuelto a hacer nada con el Word :-(, pero si puedo os hechare una mano

Un saludo
Juan Ignacio Forteza del Rey Oteiza
jfo@tragsatec.es



Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com