Diseñar tablas en word desde vb6.0

christianMen · #1 (**permalink**) 27/02/2006, 14:19

Hola, como estan ?...saludos desde mi bellisima ciudad de colima...jejeje, les escribo por una peticion y ayuda... estoy haciendo un sistema en el que generan varios oficios, varios reportes y otros formatos, estube trabajando con el vsview.... pero, tengo un problema resulta que estos formatos, reportes, etc. constantemente cambian en sus estructura y logotipos... entonces se me ocurrio trabajar con word... hay una carta que utilizo en word en la que la estructura del documento ya esta creado y tiene varios marcadores, que son como quien dice las variables en las que coloco los valores desde visual basic... bueno, algo asi quiero utilizar con los demas documentos, pero el otro detalle es que necesito crear tablas en word...manipularlas desde visual basic, y no se como se hace, no puedo encontrar un ejemplo. Aqui les mando una parte de lo que yo utilizo para mandar los valores a word:

Public Sub EnviarWord()
Dim Documento As New Word.Application

With Documento
' ABRE EL DOCUMENTO WORD
'----------------------------------------------------
.Application.Documents.Open App.Path & "\Documento\reporte3.doc"
'----------------------------------------------------

.Documents.Item(1).Bookmarks.Item("NomCorto").Rang e.Text = NombreCORTO
.Documents.Item(1).Bookmarks.Item("IniDepto").Rang e.Text = INIDepa
.Documents.Item(1).Bookmarks.Item("IniCarre").Rang e.Text = INICarre
.Documents.Item(1).Bookmarks.Item("Numero").Range. Text = Format(TxtNumOficio.Text, "000")
.Documents.Item(1).Bookmarks.Item("Ano").Range.Tex t = Anis
.Documents.Item(1).Bookmarks.Item("Fecha").Range.T ext = Format(Day(DTFecha.Value), "00") & " de " & LCase(Format(DTFecha.Value, "mmmm")) & " del " & Year(DTFecha.Value)
.Documents.Item(1).Bookmarks.Item("Responsable").R ange.Text = Titular
.Documents.Item(1).Bookmarks.Item("Puesto").Range. Text = PtoTitular
.Documents.Item(1).Bookmarks.Item("Empresa").Range .Text = Empresa
Select Case Sex
Case 1: .Documents.Item(1).Bookmarks.Item("Letras").Range. Text = "al"
Case 2: .Documents.Item(1).Bookmarks.Item("Letras").Range. Text = "a la"
End Select
.Documents.Item(1).Bookmarks.Item("Control").Range .Text = TxtCtrl.Text
.Documents.Item(1).Bookmarks.Item("EmpresSeguro"). Range.Text = EmpSeg
.Documents.Item(1).Bookmarks.Item("JefeDepto").Ran ge.Text = JefeGes
.Documents.Item(1).Bookmarks.Item("Copias").Range. Text = Copyas

.Application.Visible = True ' SE MUESTRA EL DOCUMENTO

End With
Set Documento = Nothing

......

zabait · #2 (**permalink**) 01/03/2006, 03:23

Ahí va mi código de algunas de las funciones que utilizo para generar word.

En este caso solo os pondré las referentes al manejo de tablas

Se encsitan dos variables:

appWord word.application
docWord word.document

Código:

Function docCrearTabla(numcols As Integer, numrows As Integer)

    docWord.Tables.Add Range:=appWord.Selection.Range, numrows:=numrows, NumColumns:=numcols
        
    With appWord.Selection.Tables(appWord.Selection.Tables.Count)
        If .Style <> "Tabla con cuadrícula" Then
            .Style = "Tabla con cuadrícula"
        End If
        
        .Columns(1).Width = 230    
        .Columns(2).Width = 75     
        .Columns(3).Width = 50     
        .Columns(4).Width = 75     
                
    End With

End Function

Function docCombinarCeldas(numceldas As Integer)

    appWord.Selection.MoveRight Unit:=wdCharacter, Count:=numceldas, Extend:=wdExtend
    appWord.Selection.Cells.Merge
    
End Function

Function docFormatearPrimeraLineaTabla(numtablas As Integer)

    Dim i As Integer
    
    For i = 1 To appWord.Selection.Tables(appWord.Selection.Tables.Count).Columns.Count
'        appWord.Selection.Tables(appWord.Selection.Tables.Count).Cell(0, i).Row.Alignment = wdAlignRowCenter
        appWord.Selection.Tables(appWord.Selection.Tables.Count).Cell(1, i).Row.Borders.InsideLineWidth = wdLineWidth150pt
        appWord.Selection.Tables(appWord.Selection.Tables.Count).Cell(1, i).Row.Borders.OutsideLineWidth = wdLineWidth150pt
        appWord.Selection.Tables(appWord.Selection.Tables.Count).Cell(1, i).Shading.BackgroundPatternColor = wdColorGray30
    Next
    
End Function

Con esto ya puedes jugar un rato, no????

christianMen · #3 (**permalink**) 01/03/2006, 03:27

Muchas gracias por tu ayuda, voy a tratar haber que pasa....sale !!! bye

MACfusilex · #4 (**permalink**) 01/03/2006, 18:01

Hola que mas, no se si te sirva mas trabajar con excel, ya que este programa maneja mucho mejor las tablas y puedes hacer con ellas desde Vb todo lo que quieras, si te interesa solo me avisas.

christianMen · #5 (**permalink**) 03/03/2006, 01:45

HOLA de nuevo, si me sirvio lo que me mandaste, pero ahora se me ocurrio algo que podria ser màs facil, pero no se si se podrà hacer:

Tengo la plantilla en word, y esta ya tiene una tabla de rows = 5 y cols =5, puedo colocarle datos a esa tabla, sin tener que crearla en visual basic ... el codigo que me ayudaste, creo la tabla y luego empiezo a colocar los datos en las celdas... y creo que seria mas facil tener en la plantilla la tabla con un diseño especifico y luego colocarle datos en las celdas que uno quiera... se podrá ?

este es la parte del codigo que utilizó ahorita para crear la tabla:

Documento.Tables.Add Range:=Word.Selection.Range, NumRows:=5, NumColumns:=5
With Word.Selection.Tables(Word.Selection.Tables.Count)
If .Style <> "Tabla con cuadrícula" Then
.Style = "Tabla con cuadrícula"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
.Cell(1, 1).Range.InsertAfter ("HOLA")
End With
.....
Yo intente quitarle la parte de la creacion de la tabla, pero cuando llega al "With ..." Me marca un error de que no existe la tabla...
asi es como lo dejo:

With Word.Selection.Tables(Word.Selection.Tables.Count)
If .Style <> "Tabla con cuadrícula" Then
.Style = "Tabla con cuadrícula"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
.Cell(1, 1).Range.InsertAfter ("HOLA")
End With
.....

y es logico porque no hay una tabla creada.... que podría hacer ?, para irme directamente a insertar en las celdas de la tabla la cual ya esta creada en la plantilla....

Todo esto lo quiero hacer para evitarme darle disño a las tablas desde visual basic, diseño como cambiar el numero de columnas, el tamaño de las columnas, celdas que son de otro color, de otro tipo de letra, etc... que haciendolo desde vb sería mas complicado... y si ya se tiene una tabla con con el diseño, tamaño y celdas que son pues sería mas sencillo imprimir en el doc. datos en la celdas que uno quiera...No marcadores no sería porque tendria que hacer uno por cada celda de la tabla.

Jejeje espero me halla esplicado bien.. Saludos !

mariona · #6 (**permalink**) 03/03/2006, 20:01

Pues añades en las partes de la tabla donde quieras que aparezcan los datos unos marcadores,pero los añades dentro del Word a la plantilla que tienes.
Despues unicamente es decirle a Visual donde debe colocar cada variable en funcion de los marcadores que creaste.No te pongo codigo pq no me acuerdo bien como era,pero yo hice exactamente eso que tu quieres hacer en una aplicacion,y funciona a la perfeccion.
Supon que tienes en la plantilla de Word un marcador llamado cadena,pues para guardar "variable" en cadena el final de la sentencia era,creo:

.bookmark(cadena)=variable

No estoy seguro del todo,pero que haciendo eso que te digo arriba rula bien,eso si que te lo aseguro 100%

mariona · #7 (**permalink**) 03/03/2006, 20:02

Pues añades en las partes de la tabla donde quieras que aparezcan los datos unos marcadores,pero los añades dentro del Word a la plantilla que tienes.
Despues unicamente es decirle a Visual donde debe colocar cada variable en funcion de los marcadores que creaste.No te pongo codigo pq no me acuerdo bien como era,pero yo hice exactamente eso que tu quieres hacer en una aplicacion,y funciona a la perfeccion.
Supon que tienes en la plantilla de Word un marcador llamado cadena,pues para guardar "variable" en cadena el final de la sentencia era,creo:

.bookmark(cadena)=variable

No estoy seguro del todo,pero que haciendo eso que te digo arriba rula bien,eso si que te lo aseguro 100%,aunque no quieras hacerlo asi creo que es lo mas comodo

zabait · #8 (**permalink**) 10/03/2006, 02:37

Exacto mariona, pero no le has dicho cómo ir al marcador

Código:

Function docIrAMarcador(sMarcador As String) As Boolean

Dim bError As Boolean
On Error GoTo ErrorMarcador
appWord.Selection.GoTo wdGoToBookmark, Name:=sMarcador
On Error GoTo 0
docIrAMarcador = Not bError
Exit Function

ErrorMarcador:
bError = True
Resume Next

End Function

Y tampoco le has dicho como, después de colocarte en el marcador que has creado en la tabla, pasar de celda en celda...

Código:

Function docIrASiguienteCelda() As Boolean

' Para el gestor de errores
Dim bError As Boolean
On Error GoTo ErrorCelda
appWord.Selection.MoveRight Unit:=wdCell
On Error GoTo 0
docIrASiguienteCelda = Not bError
Exit Function

ErrorCelda:
bError = True
Resume Next

End Function

Espero que con esto ya...

leo_luna · #9 (**permalink**) 07/08/2006, 12:11

hola, yo estoy haciendo algo parecido pero tengo un problema a la hora de buscar los marcadores...

lo que ocurre es que cuando declaro las objetos de word haciendo referencia a microsoft word 11.0 object library si funciona

pero cuando declaro los objetos como o"bject"

dim obj as object

y luego los seteo

set objDoc= createobject("word.aplication")

la propiedad

Selection.goto wdGoToBookmark, Name:="a" no me funciona, la palabra reservada wdGoToBookMark la marca como si fuera una variable no declarada

que puedo ahcer saludos

edgrod01 · #10 (**permalink**) 18/09/2006, 08:57

On Error GoTo err
Dim i As Integer
Dim row As Integer
Dim IDE_DOC As String
Dim IDE_USER As String
Dim GT_SQL_EPS As String

Set appword = CreateObject("Word.Application")
Set docword = appword.Documents.Open(App.Path & "\informes\informe_platilla.dot")
appword.Visible = True
docword.Select
docword.Activate
Set selword = appword.Selection

'****************** CONSULTA ***********************************
sdg_PROCEDIMIENTO.MoveFirst
For row = 0 To sdg_PROCEDIMIENTO.Rows - 1
If sdg_PROCEDIMIENTO.Columns("imprimir").Value = -1 Then

' For i = 0 To rs_inf.RecordCount - 1
Set RS_EPS = New ADODB.Recordset
GT_SQL_EPS = "select nomtercero " & _
"from gentercero " & _
"where idtercero =" & rs_inf("IDE_EPS")
RS_EPS.Open GT_SQL_EPS, con_fcv

ActiveDocument.Tables.Add Range:=selword.Range, NumRows:=4, NumColumns:= _
4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Selection.Tables(1).Columns(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).Columns(1).PreferredWidth = CentimetersToPoints(2.41)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(5.24)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(2.63)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(4.96)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn
With Selection.Tables(1)
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
Selection.MoveDown Unit:=wdLine, Count:=1
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
'Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=399.45, RulerStyle:= _
wdAdjustNone
Selection.Tables(1).Rows(5).SetHeight RowHeight:=450.75, HeightRule:= _
wdRowHeightAtLeast
With Selection.Tables(1)
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
Selection.Tables(1).Rows(5).SetHeight RowHeight:=443.35, HeightRule:= _
wdRowHeightAtLeast
Selection.MoveDown Unit:=wdLine, Count:=1
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=5, NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed

With Selection.Tables(1)
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
With Selection.Tables(1)
.TopPadding = CentimetersToPoints(0)
.BottomPadding = CentimetersToPoints(0)
.LeftPadding = CentimetersToPoints(0.12)
.RightPadding = CentimetersToPoints(0.12)
.Spacing = 0
.AllowPageBreaks = True
.AllowAutoFit = True
End With
Selection.MoveUp Unit:=wdLine, Count:=1
With Selection.Tables(1)
.TopPadding = CentimetersToPoints(0)
.BottomPadding = CentimetersToPoints(0)
.LeftPadding = CentimetersToPoints(0.12)
.RightPadding = CentimetersToPoints(0.12)
.Spacing = 0
.AllowPageBreaks = True
.AllowAutoFit = False
End With
'ActiveDocument.ActivePane.VerticalPercentScrolled = 42
Selection.MoveUp Unit:=wdLine, Count:=4
'ActiveDocument.ActivePane.VerticalPercentScrolled = 0
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="FECHA:"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.TypeText Text:=Format(rs_inf("FECHA"), "DD-MMMM-YYYY")
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="ENTIDAD:"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.TypeText Text:=RS_EPS("nomtercero")
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="PACIENTE:"
'Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.TypeText Text:=rs_inf("nom_pac")
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="HORA:"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.TypeText Text:=Format(rs_inf("FECHA"), "HH:MM")
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="CAMA:"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.TypeText Text:=rs_inf("CAMA")
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Nro. REGIS:"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.TypeText Text:=rs_inf("REGISTRO")
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="ESTUDIO:"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 10
Selection.TypeText Text:=rs_inf("ESTUDIO")
Selection.MoveRight Unit:=wdCharacter, Count:=1

End If
sdg_PROCEDIMIENTO.MoveNext
Next row

exit_:
Exit Sub
err:
'wApp.ActiveDocument.Close savechanges:=wdDoNotSaveChanges
MsgBox err.Description
Resume exit_

End Sub