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