Pasar a .doc

Me gustaria saber como pasar los datos de una estructura a un documento .doc en Visual Basic 6.0.

2 Respuestas

Respuesta
1
Estructura de qué, de datos, de un archivo...
Pongamos que yo tengo unos datos metidos en un array, y quisiera pasarlos a que se vean en un documento word, se ponerlos en un fichero txt, pero me interesaria un word, no se es una exigencia que me han puesto. es alguna cosa especial la que hay que hacer o simplemente como si fuese un fichero. Si te sirve de algo lo que voy a mostrar en ese documento son las preguntas incorrectas de un test.
Gracias de nuevo
Tienes que hacer algo como lo siguiente:
Function GeneraRelacionWord(sQuienEnvia As String, sNombreEnvia As String, sQuienAutoriza As String, sNombreAutoriza As String, sLeyenda As String, sRelacion As String) As Boolean
Dim sQuery As String
' objetos para crear un objeto de word
Dim wordDoc As Object
Dim WordApp As Object
Dim strDocto As String
Dim rsDatos As New ADODB.Recordset
Dim sCantidad As String
Dim bPrimero As Boolean
Dim cSuma1 As Currency
Dim cSuma2 As Currency
Dim cSuma3 As Currency
Dim cSuma4 As Currency
On Error GoTo ErrHdlrReportar
GeneraRelacionWord = False
strDocto = "pagosserviciomedico"
bPrimero = False
sQuery = "select distinct a.folio," & Chr(13)
sQuery = sQuery & " a.recurso_medico," & Chr(13)
sQuery = sQuery & " b.descripcion," & Chr(13)
sQuery = sQuery & " a.importe," & Chr(13)
sQuery = sQuery & " a.importe_agrupacion," & Chr(13)
sQuery = sQuery & " a.importe_jubilados," & Chr(13)
sQuery = sQuery & " upper(isnull(generado_agrupacion_sn, 'N')) as 'agrupado'," & Chr(13)
sQuery = sQuery & " isnull(folio_agrupacion, -1) as 'folio_agrupacion'," & Chr(13)
sQuery = sQuery & " b.retener_isr_sn" & Chr(13)
sQuery = sQuery & " from pagos_recursos_medicos a," & Chr(13)
sQuery = sQuery & " recursos_medicos b" & Chr(13)
sQuery = sQuery & " where a.compania = '" & sCompania & "'" & Chr(13)
sQuery = sQuery & " and a.relacion = '" & sRelacion & "'" & Chr(13)
sQuery = sQuery & " and (a.folio_agrupacion is null and generado_agrupacion_sn is null or importe_agrupacion is not null)" & Chr(13)
sQuery = sQuery & " and b.compania = a.compania" & Chr(13)
sQuery = sQuery & " and b.recurso_medico = a.recurso_medico" & Chr(13)
If cnx.gf_AbreRecordset(gcxRecursos, grsRecordset, sQuery, adOpenForwardOnly) Then
If Not grsRecordset.EOF Then
' abrimos el objeto de word
Set WordApp = CreateObject("Word.Application")
' instanciamos la apertura del documento de reporte
Set wordDoc = WordApp.Documents.Open(App.Path & "\..\Documentos\pagosserviciomedico.doc")
'Set wordDoc = WordApp.Documents.Open(PATHREPORTES & strDocto & ".doc")
' se deja ver el aplicativo de word
'WordApp.Visible = True
cSuma1 = 0#
cSuma2 = 0#
cSuma3 = 0#
cSuma4 = 0#
Set rsDatos = New ADODB.Recordset
wordDoc.fields(1).result.Text = "LIC. " & sNombreAutoriza 'Quien Envia
sQuery = " SELECT descripcion From categorias WHERE compania = '" & sCompania & "' AND categoria IN (SELECT categoria FROM empleados WHERE compania = '" & sCompania & "' AND empleado = '" & sQuienAutoriza & "')"
If cnx.gf_AbreRecordset(gcxRecursos, rsDatos, sQuery, adOpenForwardOnly) Then
If Not rsDatos.EOF Then
wordDoc.fields(2).result.Text = Trim$(rsDatos.fields(0)) ' número de expediente
Else
wordDoc.fields(2).result.Text = ""
End If
End If
rsDatos.Close
Set rsDatos = Nothing
wordDoc.fields(3).result.Text = sLeyenda
wordDoc.fields(4).result.Text = sRelacion
wordDoc.fields(5).result.Text = ""
WordApp.Selection.MoveDown Unit:=wdLine, Count:=13
'Selection.GoTo What:=wdGoToBookmark, Name:="Insertartabla"
'Selection.Find.ClearFormatting
Do While Not grsRecordset.EOF
WordApp.Selection.TypeText Text:=CStr(grsRecordset.fields("folio"))
WordApp.Selection.MoveRight Unit:=wdCell
WordApp.Selection.TypeText Text:=CStr(grsRecordset.fields("recurso_medico") & " " & grsRecordset.fields("descripcion"))
WordApp.Selection.MoveRight Unit:=wdCell
If IsNull(grsRecordset.fields("importe_agrupacion")) Then
WordApp.Selection.TypeText Text:=Format$(grsRecordset.fields("importe"), "###,###,##0.00")
cSuma1 = cSuma1 + grsRecordset.fields("importe")
Else
WordApp.Selection.TypeText Text:=Format$(grsRecordset.fields("importe_agrupacion"), "###,###,##0.00")
cSuma1 = cSuma1 + grsRecordset.fields("importe_agrupacion")
End If
WordApp.Selection.MoveRight Unit:=wdCell
If grsRecordset.fields("retener_isr_sn") = "S" Then
If IsNull(grsRecordset.fields("importe_agrupacion")) Then
If (Int(grsRecordset.fields("importe") * 0.1)) - (grsRecordset.fields("importe") * 0.1) = 0 Then
sCantidad = CStr(grsRecordset.fields("importe") * 0.1)
Else
If Mid$(Trim$(CStr(grsRecordset.fields("importe") * 0.1)), Len(Trim$(CStr(grsRecordset.fields("importe") * 0.1))) - 2, 1) <> "." Then
If Mid$(Trim$(CStr(grsRecordset.fields("importe") * 0.1)), Len(Trim$(CStr(grsRecordset.fields("importe") * 0.1))) - 1, 1) <> "." Then
sCantidad = Mid$(Trim$(CStr(grsRecordset.fields("importe") * 0.1)), 1, Len(Trim$(CStr(grsRecordset.fields("importe") * 0.1))) - 1)
Else
sCantidad = Mid$(Trim$(CStr(grsRecordset.fields("importe") * 0.1)), 1, Len(Trim$(CStr(grsRecordset.fields("importe") * 0.1))))
End If
Else
sCantidad = Mid$(Trim$(CStr(grsRecordset.fields("importe") * 0.1)), 1, Len(Trim$(CStr(grsRecordset.fields("importe") * 0.1))))
End If
End If
Else
If (Int(grsRecordset.fields("importe_agrupacion") * 0.1)) - (grsRecordset.fields("importe_agrupacion") * 0.1) = 0 Then
sCantidad = CStr(grsRecordset.fields("importe_agrupacion") * 0.1)
Else
'sCantidad = Mid$(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1)), 1, Len(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1))) - 1)
If Mid$(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1)), Len(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1))) - 2, 1) <> "." Then
If Mid$(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1)), Len(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1))) - 1, 1) <> "." Then
sCantidad = Mid$(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1)), 1, Len(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1))) - 1)
Else
sCantidad = Mid$(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1)), 1, Len(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1))))
End If
Else
sCantidad = Mid$(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1)), 1, Len(Trim$(CStr(grsRecordset.fields("importe_agrupacion") * 0.1))))
End If
End If
End If
WordApp.Selection.TypeText Text:=Format$(Val(sCantidad), "###,###,##0.00")
cSuma2 = cSuma2 + Val(sCantidad)
Else
WordApp.Selection.TypeText Text:=Format$(0#, "###,###,##0.00")
End If
WordApp.Selection.MoveRight Unit:=wdCell
If IsNull(grsRecordset.fields("importe_agrupacion")) Then
WordApp.Selection.TypeText Text:=Format$(grsRecordset.fields("importe") - Val(sCantidad), "###,###,##0.00")
cSuma3 = cSuma3 + (grsRecordset.fields("importe") - Val(sCantidad))
Else
WordApp.Selection.TypeText Text:=Format$(grsRecordset.fields("importe_agrupacion") - Val(sCantidad), "###,###,##0.00")
cSuma3 = cSuma3 + (grsRecordset.fields("importe_agrupacion") - Val(sCantidad))
End If
cSuma4 = cSuma4 + grsRecordset.fields("importe_jubilados")
grsRecordset.MoveNext
If Not grsRecordset.EOF Then
WordApp.Selection.MoveRight Unit:=wdCell
End If
sCantidad = ""
If Not bPrimero Then
WordApp.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
WordApp.Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
With WordApp.Selection.Cells
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With WordApp.Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
WordApp.Selection.GoTo What:=wdGoToBookmark, Name:="Insertartabla"
WordApp.Selection.MoveRight Unit:=wdCell
WordApp.Selection.MoveRight Unit:=wdCell
WordApp.Selection.MoveRight Unit:=wdCell
WordApp.Selection.MoveRight Unit:=wdCell
WordApp.Selection.MoveRight Unit:=wdCell
bPrimero = True
End If
Loop
grsRecordset.Close
Set grsRecordset = Nothing
End If
End If
wordDoc.fields(6).result.Text = Format$(cSuma1, "###,###,###,##0.00")
wordDoc.fields(7).result.Text = Format$(cSuma2, "###,###,###,##0.00")
wordDoc.fields(8).result.Text = Format$(cSuma3, "###,###,###,##0.00")
wordDoc.fields(9).result.Text = Format$(cSuma4, "###,###,###,##0.00")
wordDoc.fields(10).result.Text = "LIC. " & sNombreEnvia
Set rsDatos = New ADODB.Recordset
sQuery = " SELECT descripcion From categorias WHERE compania = '" & sCompania & "' AND categoria IN (SELECT categoria FROM empleados WHERE compania = '" & sCompania & "' AND empleado = '" & sQuienEnvia & "')"
If cnx.gf_AbreRecordset(gcxRecursos, rsDatos, sQuery, adOpenForwardOnly) Then
If Not rsDatos.EOF Then
wordDoc.fields(11).result.Text = Trim$(rsDatos.fields(0)) ' número de expediente
Else
wordDoc.fields(11).result.Text = ""
End If
End If
rsDatos.Close
Set rsDatos = Nothing
WordApp.Visible = True
' Set wordDoc = Nothing
' Set WordApp = Nothing
Screen.MousePointer = vbNormal
Exit Function
error:
MsgBox error & " " & Err
Screen.MousePointer = 0
Screen.MousePointer = vbDefault
ErrHdlrReportar:
WordApp.Quit
Set wordDoc = Nothing
Set WordApp = Nothing
MsgBox Err.Number & " " & Err.Description
'MsgBox error$
Screen.MousePointer = 0
Screen.MousePointer = vbDefault
Exit Function
End Function
Adaptala a tus necesidades y listo...
Respuesta
Desde Access habiendo obtenido la estructura a través de Herramientas, Documentador en la barra de Vista Preliminar existe un vínculo con Office y ahí se puede seleccionar la Opción Publicar con MS Word.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Cifras de números a letras

Andi DE vuelta. Sabés que un importe, por ejemplo, 7.300.- aparece en letras SIETE TRESCIENTAS ¿Qué puede pasar?
1 respuesta

Cifras o importe en letras

Necesito que un informe en el cual debo confeccionar un recibo me escriba el importe en letras de un importe que coloco en números. Tengo el código que me informo un colega tuyo (ahora no disponible) pero no me explicó el procedimiento para que...
1 respuesta

Como crear sesiones Independientes Lotus Notes

Hice una aplicaicón en lotus Domino Designer 6.54 La estoy corriendo en un servidor 8.5... Tiene un Frame, Page, OutLines para poder organizar las vistas que aparecen... Ahora: El detalle de todo esto es que Tengo una vista que indique los permisos...
1 respuesta

Ayuda en impresión

No sé si me puedas dar una ayudita, estoy haciendo un reporte utilizando la sentencia print mostrando datos numéricos, cuando envío a imprimir sale descuadrado el reporte. He intentando poniéndole el format al número, utilizando el space. Te envío un...
1 respuesta

Instrucciones para hacer un programa para una empresa. Conexión al servidor y diferentes menús.

Lo que debo hacer es un programa... Algo asi como un sisema que se conecte al servidor y tenga los siguientes menus ... Menu, operations, reports, salir... El nombre de la empresa puede ser practica... Y la idea es que haya un icono en el exritorio...
1 respuesta

Crear una Dll con Vb6.0

Quiero crear una dll con vb y que pueda ser llamada desde otros programas. Tengo el código compilado y la dll creada pero cuando la llamo desde vb u otro programa me da el siguiente error: "no se puede encontrar el punto de entrada de la DLL xxxx"...
1 respuesta

Layout desde weba un archivo txt y excel

Necesito hacer un layout desde una forma a un archivo .txt, ya lo pude hacer desde el cliente de Lotus note pero cuando lo corro desde web no me hace caso, no funciona, tu me podrias ayudar a generar uno desde la web con un formulario abierto y que...
1 respuesta

Lotus Notes y DECS

Necesito conectar el servidor Domino (6.51) con bases de datos externas (Ms access vía ODBC). Para ello estoy tratando de usar DECS, pero aunque sigo el manuala, algo falla y no sé qué estoy haciendo mal. Si sabes sobre conexión con bases de datos...
1 respuesta

¿Cómo puedo importar txt a base de datos en vb 6.0?

Estoy haciendo un sistema y me trabe, lo que pasa es que tengo un formulario en vb 6.0 y en este tengo que mostrar los datos de un *.txt y no se como jalarlos, ademas me gustaría que me dijera sobre que componente debo insertar primero para que pueda...
1 respuesta

¿Cómo ejecutar botón con un TexBox al presionar enter?

La verdad apenas empiezo a programar. Y en mi aplicación deseo que al presionar enter en un texbox se ejecute un botón. Yo puse algo así. Try KeyPressText(sender, e) If e.KeyAcsi = Chr(13) Then If Len(TextBox1.Text) > 0 Then End If End If Catch ex As...
1 respuesta