| excelente, te servira aunque un poco tarde
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 |